Análisis de Componentes Principales aplicado a la base russett
Jhonatan Alexis Ortega
Taller ACP 26-II
- 1 Introducción
- 2 Preparación de los datos
- 3 Punto 1. Estandarización, matriz de correlaciones e inercia
- 4 Punto 2. Descomposición SVD, valores propios y vectores propios
- 5 Punto 3. Cálculo y verificación de CP1 y CP2
- 6 Punto 4. Representación simultánea de individuos y variables
- 7 Punto 5. Estrategia para mejorar la inercia del primer plano
- 8 Punto 6. ACP mejorado, representación simultánea y contribuciones
- 9 Punto 7. Índice de países e interpretación práctica
- 10 Gráficas obtenidas en el análisis del taller
- 11 Conclusiones
- 12 Revisión antes de entregar
1 Introducción
El Análisis de Componentes Principales (ACP) permite resumir la
variabilidad de un conjunto de variables cuantitativas mediante
combinaciones lineales no correlacionadas denominadas componentes
principales. En este informe se analiza la base russett, se
calcula un ACP normado mediante operaciones matriciales y descomposición
en valores singulares, y se compara con el resultado obtenido mediante
FactoMineR.
El informe debe leerse junto con el código y las salidas generadas por R. Las interpretaciones de países se entienden como posiciones relativas en el espacio factorial, no como clasificaciones absolutas de desarrollo o bienestar.
2 Preparación de los datos
if (!requireNamespace("plspm", quietly = TRUE)) {
stop("Instala el paquete plspm con install.packages('plspm').")
}
data("russett", package = "plspm")
datos <- as.data.frame(russett)
cat("Dimensiones de la base:\n")## Dimensiones de la base:print(dim(datos))## [1] 47 11cat("\nNombres de las variables:\n")##
## Nombres de las variables:print(names(datos))## [1] "gini" "farm" "rent" "gnpr" "labo" "inst"
## [7] "ecks" "death" "demostab" "demoinst" "dictator"cat("\nPrimeras filas:\n")##
## Primeras filas:print(head(datos))## gini farm rent gnpr labo inst ecks death demostab demoinst dictator
## Argentina 86.3 98.2 3.52 5.92 3.22 0.07 4.06 5.38 0 1 0
## Australia 92.9 99.6 3.40 7.10 2.64 0.01 0.00 0.00 1 0 0
## Austria 74.0 97.4 2.46 6.28 3.47 0.03 1.61 0.00 0 1 0
## Belgium 58.7 85.8 4.15 6.92 2.30 0.45 2.20 0.69 1 0 0
## Bolivia 93.8 97.7 3.04 4.19 4.28 0.37 3.99 6.50 0 0 1
## Brasil 83.7 98.5 2.31 5.57 4.11 0.45 3.91 0.69 0 1 0cat("\nNombres de los individuos:\n")##
## Nombres de los individuos:print(rownames(datos))## [1] "Argentina" "Australia" "Austria"
## [4] "Belgium" "Bolivia" "Brasil"
## [7] "Canada" "Chile" "Colombia"
## [10] "CostaRica" "Cuba" "Denmark"
## [13] "DominicanRepublic" "Ecuador" "Egypt"
## [16] "Salvador" "Finland" "France"
## [19] "Guatemala" "Greece" "Honduras"
## [22] "India" "Irak" "Ireland"
## [25] "Italy" "Japan" "Libia"
## [28] "Luxemburg" "TheNetherlands" "NewZealand"
## [31] "Nicaragua" "Norway" "Panama"
## [34] "Peru" "Philippine" "Poland"
## [37] "SouthVietnam" "Spain" "Sweden"
## [40] "Switzerland" "Taiwan" "UK"
## [43] "USA" "Uruguay" "Venezuela"
## [46] "WestGermany" "Yugoslavia"En el código del taller se consideran suplementarias las variables
demostab, demoinst y dictator, y
se establece la fila 8 como individuo suplementario. Como el trabajo se
realiza individualmente, debe confirmarse que la fila 8 corresponde al
número de lista asignado.
variables_suplementarias <- c("demostab", "demoinst", "dictator")
fila_suplementaria <- 8
if (fila_suplementaria > nrow(datos)) {
stop("La fila suplementaria indicada supera el número de filas de la base.")
}
variables_activas <- setdiff(names(datos), variables_suplementarias)
variables_activas <- variables_activas[
vapply(datos[, variables_activas, drop = FALSE], is.numeric, logical(1))
]
datos_activos <- datos[-fila_suplementaria, , drop = FALSE]
X <- datos_activos[, variables_activas, drop = FALSE]
if (anyNA(X)) stop("Hay valores faltantes en las variables activas.")
if (any(vapply(X, sd, numeric(1)) == 0)) {
stop("Hay variables constantes que no se pueden estandarizar.")
}
n <- nrow(X)
p <- ncol(X)
cat("Número de individuos activos:", n, "\n")## Número de individuos activos: 46cat("Número de variables activas:", p, "\n")## Número de variables activas: 8cat("Individuo suplementario:\n")## Individuo suplementario:print(rownames(datos)[fila_suplementaria])## [1] "Chile"cat("Variables activas:\n")## Variables activas:print(colnames(X))## [1] "gini" "farm" "rent" "gnpr" "labo" "inst" "ecks" "death"3 Punto 1. Estandarización, matriz de correlaciones e inercia
Cada variable se centra restándole su media y se divide por su desviación estándar calculada con divisor \(n\). Por tanto, la matriz de inercia es
\[ \Sigma = Z^\top N Z = \frac{1}{n}Z^\top Z, \qquad N=\frac{1}{n}I_n. \]
Con esta convención, la matriz \(\Sigma\) debe coincidir con la matriz de correlaciones de Pearson de las variables originales, salvo diferencias numéricas de redondeo.
X_centrada <- scale(X, center = TRUE, scale = FALSE)
desviaciones_n <- sqrt(colSums(X_centrada^2) / n)
Z <- sweep(X_centrada, 2, desviaciones_n, FUN = "/")
N <- diag(1 / n, nrow = n, ncol = n)
Sigma <- t(Z) %*% N %*% Z
R <- cor(X)
cat("Matriz de inercia Sigma:\n")## Matriz de inercia Sigma:print(round(Sigma, 6))## gini farm rent gnpr labo inst ecks
## gini 1.000000 0.938744 0.425945 -0.280262 0.271719 0.153857 0.288119
## farm 0.938744 1.000000 0.485083 -0.361292 0.310556 0.126454 0.346361
## rent 0.425945 0.485083 1.000000 -0.083201 -0.187994 0.071450 0.094198
## gnpr -0.280262 -0.361292 -0.083201 1.000000 -0.826616 -0.147003 -0.545024
## labo 0.271719 0.310556 -0.187994 -0.826616 1.000000 0.247652 0.497733
## inst 0.153857 0.126454 0.071450 -0.147003 0.247652 1.000000 0.331210
## ecks 0.288119 0.346361 0.094198 -0.545024 0.497733 0.331210 1.000000
## death 0.450235 0.425546 0.296890 -0.526942 0.515612 0.081147 0.632739
## death
## gini 0.450235
## farm 0.425546
## rent 0.296890
## gnpr -0.526942
## labo 0.515612
## inst 0.081147
## ecks 0.632739
## death 1.000000cat("\nMatriz de correlaciones cor(X):\n")##
## Matriz de correlaciones cor(X):print(round(R, 6))## gini farm rent gnpr labo inst ecks
## gini 1.000000 0.938744 0.425945 -0.280262 0.271719 0.153857 0.288119
## farm 0.938744 1.000000 0.485083 -0.361292 0.310556 0.126454 0.346361
## rent 0.425945 0.485083 1.000000 -0.083201 -0.187994 0.071450 0.094198
## gnpr -0.280262 -0.361292 -0.083201 1.000000 -0.826616 -0.147003 -0.545024
## labo 0.271719 0.310556 -0.187994 -0.826616 1.000000 0.247652 0.497733
## inst 0.153857 0.126454 0.071450 -0.147003 0.247652 1.000000 0.331210
## ecks 0.288119 0.346361 0.094198 -0.545024 0.497733 0.331210 1.000000
## death 0.450235 0.425546 0.296890 -0.526942 0.515612 0.081147 0.632739
## death
## gini 0.450235
## farm 0.425546
## rent 0.296890
## gnpr -0.526942
## labo 0.515612
## inst 0.081147
## ecks 0.632739
## death 1.000000cat("\nError máximo entre Sigma y cor(X):\n")##
## Error máximo entre Sigma y cor(X):error_sigma <- max(abs(Sigma - R))
print(error_sigma)## [1] 4.440892e-16cat("\nInercia total:\n")##
## Inercia total:inercia_total <- sum(diag(Sigma))
print(inercia_total)## [1] 8cat("Número de variables activas:", p, "\n")## Número de variables activas: 8La inercia total corresponde a la traza de \(\Sigma\), es decir, a la suma de sus valores propios. Al estandarizar las variables con varianza unitaria usando divisor \(n\), la inercia total debe ser aproximadamente igual al número de variables activas \(p\).
4 Punto 2. Descomposición SVD, valores propios y vectores propios
La descomposición en valores singulares expresa la matriz estandarizada como \(Z=UDV^\top\). De ella se obtiene
\[ \Sigma = V\frac{D^2}{n}V^\top, \qquad \lambda_j=\frac{d_j^2}{n}. \]
descomposicion_svd <- svd(Z)
valores_singulares <- descomposicion_svd$d
valores_propios_svd <- valores_singulares^2 / n
V <- descomposicion_svd$v
U <- descomposicion_svd$u
descomposicion_eigen <- eigen(Sigma, symmetric = TRUE)
valores_propios_eigen <- descomposicion_eigen$values
cat("Valores propios obtenidos mediante SVD:\n")## Valores propios obtenidos mediante SVD:print(round(valores_propios_svd, 6))## [1] 3.582796 1.698477 0.973221 0.759173 0.529271 0.321125 0.094982 0.040956cat("\nValores propios obtenidos mediante eigen(Sigma):\n")##
## Valores propios obtenidos mediante eigen(Sigma):print(round(valores_propios_eigen, 6))## [1] 3.582796 1.698477 0.973221 0.759173 0.529271 0.321125 0.094982 0.040956cat("\nError máximo entre los valores propios:\n")##
## Error máximo entre los valores propios:error_valores_propios <- max(abs(valores_propios_svd - valores_propios_eigen))
print(error_valores_propios)## [1] 4.440892e-15cat("\nVectores propios (columnas de V):\n")##
## Vectores propios (columnas de V):print(round(V, 6))## [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,] -0.387061 0.413555 0.016676 0.394323 -0.239308 0.094276 0.217078
## [2,] -0.405791 0.401203 0.046832 0.354419 -0.109284 -0.190175 -0.121379
## [3,] -0.191690 0.544718 -0.082616 -0.488548 0.561324 -0.064059 -0.281673
## [4,] 0.400369 0.327216 -0.205821 -0.049328 -0.526155 0.259690 -0.585373
## [5,] -0.376409 -0.440182 0.120332 0.295799 0.220391 0.204555 -0.670354
## [6,] -0.169372 -0.120851 -0.930962 0.087284 0.110533 0.214776 0.128026
## [7,] -0.384434 -0.230519 -0.163191 -0.405092 -0.460794 -0.597503 -0.144261
## [8,] -0.412694 -0.052118 0.201346 -0.467514 -0.256405 0.662134 0.171951
## [,8]
## [1,] -0.640397
## [2,] 0.695501
## [3,] -0.150017
## [4,] -0.029989
## [5,] -0.150961
## [6,] 0.087540
## [7,] -0.134863
## [8,] 0.184730cat("\nSuma de valores propios:\n")##
## Suma de valores propios:print(sum(valores_propios_svd))## [1] 8cat("Inercia total del punto 1:\n")## Inercia total del punto 1:print(inercia_total)## [1] 8Los valores propios obtenidos mediante ambos procedimientos deben coincidir, salvo errores numéricos. Su suma debe coincidir con la inercia total calculada en el punto 1. Los vectores propios determinan las direcciones de las componentes principales.
5 Punto 3. Cálculo y verificación de CP1 y CP2
Las coordenadas factoriales de los individuos se calculan mediante \(F=ZV\). En particular,
\[ CP1_i=\sum_{j=1}^{p}v_{j1}z_{ij}, \qquad CP2_i=\sum_{j=1}^{p}v_{j2}z_{ij}. \]
F <- Z %*% V
F_dos <- F[, 1:2, drop = FALSE]
colnames(F_dos) <- c("CP1", "CP2")
cat("Primeras coordenadas de los individuos activos:\n")## Primeras coordenadas de los individuos activos:print(round(head(F_dos), 4))## CP1 CP2
## Argentina -1.6967 1.1173
## Australia 1.0486 2.9668
## Austria 0.6079 0.6374
## Belgium 1.7398 1.0888
## Bolivia -3.5151 -0.4290
## Brasil -1.4248 -0.3711cat("\nVerificación de ortogonalidad de V (V'V debe ser identidad):\n")##
## Verificación de ortogonalidad de V (V'V debe ser identidad):error_ortogonalidad_V <- max(abs(crossprod(V) - diag(ncol(V))))
print(error_ortogonalidad_V)## [1] 6.661338e-16cat("\nProducto interno entre CP1 y CP2:\n")##
## Producto interno entre CP1 y CP2:producto_CP1_CP2 <- sum(F_dos[, 1] * F_dos[, 2]) / n
print(producto_CP1_CP2)## [1] -6.620233e-16cat("\nMatriz de covarianzas de las componentes:\n")##
## Matriz de covarianzas de las componentes:Sigma_F <- crossprod(F) / n
print(round(Sigma_F, 6))## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 3.582796 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
## [2,] 0.000000 1.698477 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
## [3,] 0.000000 0.000000 0.973221 0.000000 0.000000 0.000000 0.000000 0.000000
## [4,] 0.000000 0.000000 0.000000 0.759173 0.000000 0.000000 0.000000 0.000000
## [5,] 0.000000 0.000000 0.000000 0.000000 0.529271 0.000000 0.000000 0.000000
## [6,] 0.000000 0.000000 0.000000 0.000000 0.000000 0.321125 0.000000 0.000000
## [7,] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.094982 0.000000
## [8,] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.040956porcentaje_inercia <- valores_propios_svd / sum(valores_propios_svd) * 100
tabla_inercia <- data.frame(
Componente = paste0("CP", seq_along(valores_propios_svd)),
Valor_propio = valores_propios_svd,
Porcentaje = porcentaje_inercia,
Acumulado = cumsum(porcentaje_inercia)
)
tabla_inercia_redondeada <- tabla_inercia
columnas_numericas <- vapply(tabla_inercia_redondeada, is.numeric, logical(1))
tabla_inercia_redondeada[columnas_numericas] <- lapply(
tabla_inercia_redondeada[columnas_numericas], round, digits = 4
)
knitr::kable(
tabla_inercia_redondeada,
caption = "Inercia explicada por las componentes principales"
)| Componente | Valor_propio | Porcentaje | Acumulado |
|---|---|---|---|
| CP1 | 3.5828 | 44.7849 | 44.7849 |
| CP2 | 1.6985 | 21.2310 | 66.0159 |
| CP3 | 0.9732 | 12.1653 | 78.1812 |
| CP4 | 0.7592 | 9.4897 | 87.6708 |
| CP5 | 0.5293 | 6.6159 | 94.2867 |
| CP6 | 0.3211 | 4.0141 | 98.3008 |
| CP7 | 0.0950 | 1.1873 | 99.4881 |
| CP8 | 0.0410 | 0.5119 | 100.0000 |
La ortogonalidad se comprueba mediante \(V^\top V=I\) y por el producto interno entre CP1 y CP2, que debe ser aproximadamente cero. El porcentaje de inercia explicado por la componente \(j\) es \(100\lambda_j/\sum_k\lambda_k\).
6 Punto 4. Representación simultánea de individuos y variables
La representación simultánea permite observar perfiles de países y relaciones entre variables en el plano CP1–CP2. Para las variables se usan sus correlaciones con las componentes; el individuo suplementario se proyecta sobre los ejes calculados con los individuos activos.
correlaciones_variables <- cor(Z, F_dos)
cat("Correlaciones de las variables con CP1 y CP2:\n")## Correlaciones de las variables con CP1 y CP2:print(round(correlaciones_variables, 4))## CP1 CP2
## gini -0.7326 0.5390
## farm -0.7681 0.5229
## rent -0.3628 0.7099
## gnpr 0.7578 0.4264
## labo -0.7125 -0.5737
## inst -0.3206 -0.1575
## ecks -0.7277 -0.3004
## death -0.7812 -0.0679# Estandarizar el individuo suplementario usando las medias y escalas
# calculadas con los individuos activos.
x_suplementario <- datos[fila_suplementaria, colnames(X), drop = FALSE]
x_suplementario <- as.data.frame(lapply(x_suplementario, as.numeric))
medias_activas <- colMeans(X)
z_suplementario <- sweep(as.matrix(x_suplementario), 2, medias_activas, "-")
z_suplementario <- sweep(z_suplementario, 2, desviaciones_n, "/")
coord_suplementario <- z_suplementario %*% V[, 1:2, drop = FALSE]
rownames(coord_suplementario) <- rownames(datos)[fila_suplementaria]
colnames(coord_suplementario) <- c("CP1", "CP2")
cat("Coordenadas del individuo suplementario:\n")## Coordenadas del individuo suplementario:print(round(coord_suplementario, 4))## CP1 CP2
## Chile -1.253 0.8008plot(
F_dos[, 1], F_dos[, 2],
type = "n",
xlab = "CP1",
ylab = "CP2",
main = "Representación simultánea del ACP original"
)
abline(h = 0, v = 0, lty = 3, col = "gray")
points(F_dos[, 1], F_dos[, 2], pch = 19, col = "steelblue")
text(F_dos[, 1], F_dos[, 2], labels = rownames(X), pos = 3, cex = 0.65)
points(coord_suplementario[1, 1], coord_suplementario[1, 2],
pch = 17, col = "darkgreen", cex = 1.3)
text(coord_suplementario[1, 1], coord_suplementario[1, 2],
labels = rownames(coord_suplementario), pos = 3, col = "darkgreen", cex = 0.75)
factor_flechas <- 2
arrows(
0, 0,
factor_flechas * correlaciones_variables[, 1],
factor_flechas * correlaciones_variables[, 2],
length = 0.08, col = "red"
)
text(
factor_flechas * correlaciones_variables[, 1],
factor_flechas * correlaciones_variables[, 2],
labels = colnames(Z), col = "red", cex = 0.8, pos = 3
)
legend(
"topright",
legend = c("País activo", "País suplementario", "Variable"),
pch = c(19, 17, NA),
lty = c(NA, NA, 1),
col = c("steelblue", "darkgreen", "red"),
bty = "n"
)
Representación simultánea del ACP original.
Países cercanos presentan perfiles similares en la proyección. Flechas en direcciones parecidas sugieren asociación positiva entre variables; flechas opuestas sugieren asociación negativa y flechas aproximadamente perpendiculares sugieren asociación débil en el plano. La interpretación debe basarse en el gráfico y las correlaciones, sin atribuir significados que no estén respaldados por los datos.
7 Punto 5. Estrategia para mejorar la inercia del primer plano
El código compara el plano original con modelos en los que se elimina
una variable activa a la vez. Se utiliza FactoMineR para
recalcular cada ACP normado. La mejora relativa se calcula como
\[ 100\frac{I_{\text{alternativa}}-I_{\text{original}}} {I_{\text{original}}}. \]
if (!requireNamespace("FactoMineR", quietly = TRUE)) {
stop("Instala FactoMineR con install.packages('FactoMineR').")
}
pca_original <- FactoMineR::PCA(as.data.frame(X), scale.unit = TRUE, graph = FALSE)
inercia_original <- sum(pca_original$eig[1:2, 2])
objetivo_relativo <- 1.05 * inercia_original
resultados_alternativas <- lapply(colnames(X), function(variable_excluida) {
X_candidata <- X[, setdiff(colnames(X), variable_excluida), drop = FALSE]
ajuste <- FactoMineR::PCA(as.data.frame(X_candidata),
scale.unit = TRUE, graph = FALSE)
plano <- sum(ajuste$eig[1:2, 2])
data.frame(
Variable_excluida = variable_excluida,
CP1 = ajuste$eig[1, 2],
CP2 = ajuste$eig[2, 2],
Inercia_acumulada = plano,
Mejora_puntos_porcentuales = plano - inercia_original,
Mejora_relativa_porcentual = 100 * (plano - inercia_original) / inercia_original
)
})
tabla_alternativas <- do.call(rbind, resultados_alternativas)
tabla_alternativas <- tabla_alternativas[
order(tabla_alternativas$Inercia_acumulada, decreasing = TRUE), ]
tabla_alternativas_redondeada <- tabla_alternativas
columnas_numericas_alt <- vapply(
tabla_alternativas_redondeada,
is.numeric,
logical(1)
)
tabla_alternativas_redondeada[columnas_numericas_alt] <-
lapply(
tabla_alternativas_redondeada[columnas_numericas_alt],
round,
digits = 4
)
knitr::kable(
tabla_alternativas_redondeada,
caption = "Comparación de alternativas al excluir una variable"
)| Variable_excluida | CP1 | CP2 | Inercia_acumulada | Mejora_puntos_porcentuales | Mejora_relativa_porcentual | |
|---|---|---|---|---|---|---|
| 6 | inst | 50.1001 | 24.0992 | 74.1993 | 8.1834 | 12.3961 |
| 3 | rent | 49.8486 | 19.3713 | 69.2199 | 3.2040 | 4.8534 |
| 7 | ecks | 44.9362 | 23.1020 | 68.0382 | 2.0222 | 3.0633 |
| 8 | death | 43.6754 | 24.2008 | 67.8762 | 1.8603 | 2.8180 |
| 4 | gnpr | 44.4788 | 21.6413 | 66.1202 | 0.1043 | 0.1579 |
| 1 | gini | 45.1332 | 20.0718 | 65.2050 | -0.8109 | -1.2283 |
| 5 | labo | 45.5316 | 19.5325 | 65.0641 | -0.9518 | -1.4417 |
| 2 | farm | 44.4335 | 20.0051 | 64.4386 | -1.5773 | -2.3893 |
cat("Inercia acumulada original:", round(inercia_original, 4), "%\n")## Inercia acumulada original: 66.0159 %cat("Objetivo relativo de mejora (105% del original):",
round(objetivo_relativo, 4), "%\n")## Objetivo relativo de mejora (105% del original): 69.3167 %En el código original del taller se seleccionó la exclusión de
INST. La tabla generada aquí permite comprobar la
alternativa y la mejora con los mismos datos activos. Una diferencia de
cinco puntos porcentuales no es exactamente lo mismo que una mejora
relativa del cinco por ciento; el criterio se debe interpretar según la
fórmula indicada por el enunciado.
8 Punto 6. ACP mejorado, representación simultánea y contribuciones
Se excluye INST y se vuelve a calcular el ACP con las
siete variables restantes. Los valores y gráficos se obtienen
directamente del objeto de FactoMineR.
# Buscar INST sin distinguir entre mayúsculas y minúsculas.
nombres_activos <- colnames(X)
indice_inst <- which(toupper(trimws(nombres_activos)) == "INST")
if (length(indice_inst) == 0) {
stop(
paste0(
"No se encontró la variable INST. Los nombres activos son: ",
paste(nombres_activos, collapse = ", ")
)
)
}
variables_punto6 <- nombres_activos[-indice_inst]
X_punto6 <- as.data.frame(X[, variables_punto6, drop = FALSE])
resultado_pca_punto6 <- FactoMineR::PCA(
X_punto6, scale.unit = TRUE, graph = FALSE
)
inercia_CP1_punto6 <- resultado_pca_punto6$eig[1, 2]
inercia_CP2_punto6 <- resultado_pca_punto6$eig[2, 2]
inercia_plano_punto6 <- inercia_CP1_punto6 + inercia_CP2_punto6
cat("Inercia de CP1:", round(inercia_CP1_punto6, 4), "%\n")## Inercia de CP1: 50.1001 %cat("Inercia de CP2:", round(inercia_CP2_punto6, 4), "%\n")## Inercia de CP2: 24.0992 %cat("Inercia acumulada:", round(inercia_plano_punto6, 4), "%\n")## Inercia acumulada: 74.1993 %cat("Contribución promedio de referencia:",
round(100 / ncol(X_punto6), 2), "%\n")## Contribución promedio de referencia: 14.29 %if (!requireNamespace("factoextra", quietly = TRUE)) {
stop("Instala factoextra con install.packages('factoextra').")
}
grafica_punto6 <- factoextra::fviz_pca_biplot(
resultado_pca_punto6,
axes = c(1, 2),
geom.ind = "point",
label = "all",
repel = TRUE,
col.ind = "steelblue",
col.var = "red",
title = "Representación simultánea del ACP mejorado (sin INST)"
)
print(grafica_punto6)
Representación simultánea del ACP mejorado sin INST.
factoextra::fviz_contrib(
resultado_pca_punto6, choice = "var",
axes = 1, top = ncol(X_punto6)
)
Contribución de las variables a CP1 y CP2.
factoextra::fviz_contrib(
resultado_pca_punto6, choice = "var",
axes = 2, top = ncol(X_punto6)
)
Contribución de las variables a CP1 y CP2.
contribuciones <- resultado_pca_punto6$var$contrib
tabla_contrib_CP1 <- data.frame(
Variable = rownames(contribuciones),
Contribucion_CP1 = contribuciones[, 1]
)
tabla_contrib_CP2 <- data.frame(
Variable = rownames(contribuciones),
Contribucion_CP2 = contribuciones[, 2]
)
knitr::kable(
tabla_contrib_CP1[order(-tabla_contrib_CP1$Contribucion_CP1), ],
digits = 2,
caption = "Contribución de las variables a CP1"
)| Variable | Contribucion_CP1 | |
|---|---|---|
| death | death | 17.97 |
| farm | farm | 17.31 |
| gnpr | gnpr | 16.54 |
| gini | gini | 15.64 |
| ecks | ecks | 14.48 |
| labo | labo | 14.17 |
| rent | rent | 3.90 |
knitr::kable(
tabla_contrib_CP2[order(-tabla_contrib_CP2$Contribucion_CP2), ],
digits = 2,
caption = "Contribución de las variables a CP2"
)| Variable | Contribucion_CP2 | |
|---|---|---|
| rent | rent | 29.80 |
| labo | labo | 20.51 |
| gini | gini | 16.49 |
| farm | farm | 15.27 |
| gnpr | gnpr | 12.07 |
| ecks | ecks | 5.30 |
| death | death | 0.55 |
cat("Coordenadas de las variables en CP1 y CP2:\n")## Coordenadas de las variables en CP1 y CP2:print(round(resultado_pca_punto6$var$coord[, 1:2, drop = FALSE], 4))## Dim.1 Dim.2
## gini 0.7406 0.5275
## farm 0.7791 0.5075
## rent 0.3698 0.7090
## gnpr -0.7615 0.4513
## labo 0.7049 -0.5883
## ecks 0.7125 -0.2990
## death 0.7939 -0.0967Con siete variables activas, la contribución promedio de referencia es \(100/7 \approx 14.29\%\). Las variables con contribuciones mayores a ese valor participan por encima del promedio en la construcción del eje. Para identificar el sentido de su relación con cada componente, también deben consultarse las coordenadas o correlaciones, ya que la contribución por sí sola no indica el signo.
9 Punto 7. Índice de países e interpretación práctica
El índice se define como la coordenada de cada país en la primera componente principal del ACP mejorado:
\[ I_i=F_{i1}. \]
Se ordenan los países por índice y se forman tres categorías utilizando los terciles de la distribución. Estas categorías son relativas al conjunto analizado.
coordenadas_CP1 <- resultado_pca_punto6$ind$coord[, 1]
indice_paises <- data.frame(
Pais = names(coordenadas_CP1),
Indice = as.numeric(coordenadas_CP1),
row.names = NULL
)
indice_paises <- indice_paises[
order(indice_paises$Indice, decreasing = TRUE), ]
cortes <- quantile(indice_paises$Indice,
probs = c(1/3, 2/3), na.rm = TRUE)
indice_paises$Categoria <- cut(
indice_paises$Indice,
breaks = c(-Inf, cortes[1], cortes[2], Inf),
labels = c("Bajo", "Medio", "Alto"),
include.lowest = TRUE
)
knitr::kable(indice_paises, digits = 3,
caption = "Índice de los países y categoría por terciles")| Pais | Indice | Categoria | |
|---|---|---|---|
| 5 | Bolivia | 3.454 | Alto |
| 22 | Irak | 2.885 | Alto |
| 10 | Cuba | 2.619 | Alto |
| 18 | Guatemala | 2.347 | Alto |
| 36 | SouthVietnam | 2.183 | Alto |
| 20 | Honduras | 2.136 | Alto |
| 8 | Colombia | 2.078 | Alto |
| 33 | Peru | 2.004 | Alto |
| 13 | Ecuador | 1.881 | Alto |
| 1 | Argentina | 1.824 | Alto |
| 44 | Venezuela | 1.632 | Alto |
| 9 | CostaRica | 1.411 | Alto |
| 14 | Egypt | 1.399 | Alto |
| 12 | DominicanRepublic | 1.332 | Alto |
| 6 | Brasil | 1.261 | Alto |
| 30 | Nicaragua | 1.207 | Medio |
| 21 | India | 1.177 | Medio |
| 37 | Spain | 1.160 | Medio |
| 15 | Salvador | 1.024 | Medio |
| 32 | Panama | 0.946 | Medio |
| 34 | Philippine | 0.820 | Medio |
| 19 | Greece | 0.728 | Medio |
| 24 | Italy | 0.694 | Medio |
| 26 | Libia | 0.517 | Medio |
| 40 | Taiwan | 0.130 | Medio |
| 43 | Uruguay | -0.176 | Medio |
| 3 | Austria | -0.489 | Medio |
| 2 | Australia | -0.897 | Medio |
| 17 | France | -1.137 | Medio |
| 25 | Japan | -1.435 | Medio |
| 42 | USA | -1.469 | Bajo |
| 23 | Ireland | -1.526 | Bajo |
| 41 | UK | -1.566 | Bajo |
| 29 | NewZealand | -1.594 | Bajo |
| 45 | WestGermany | -1.677 | Bajo |
| 16 | Finland | -1.907 | Bajo |
| 4 | Belgium | -1.932 | Bajo |
| 35 | Poland | -1.968 | Bajo |
| 31 | Norway | -2.022 | Bajo |
| 46 | Yugoslavia | -2.098 | Bajo |
| 28 | TheNetherlands | -2.103 | Bajo |
| 27 | Luxemburg | -2.276 | Bajo |
| 38 | Sweden | -2.777 | Bajo |
| 7 | Canada | -2.785 | Bajo |
| 11 | Denmark | -3.493 | Bajo |
| 39 | Switzerland | -3.519 | Bajo |
cat("\nNúmero de países por categoría:\n")##
## Número de países por categoría:print(table(indice_paises$Categoria))##
## Bajo Medio Alto
## 16 15 15cat("\nCinco índices más altos:\n")##
## Cinco índices más altos:print(head(indice_paises, 5), row.names = FALSE)## Pais Indice Categoria
## Bolivia 3.453610 Alto
## Irak 2.885048 Alto
## Cuba 2.619123 Alto
## Guatemala 2.346535 Alto
## SouthVietnam 2.183295 Altocat("\nCinco índices más bajos:\n")##
## Cinco índices más bajos:print(tail(indice_paises, 5), row.names = FALSE)## Pais Indice Categoria
## Luxemburg -2.276034 Bajo
## Sweden -2.776597 Bajo
## Canada -2.784907 Bajo
## Denmark -3.492805 Bajo
## Switzerland -3.519391 Bajobarplot(
indice_paises$Indice,
names.arg = indice_paises$Pais,
las = 2,
cex.names = 0.55,
main = "Índice de los países basado en CP1",
xlab = "Países",
ylab = "Valor del índice"
)
abline(h = 0, lty = 2)
Índice de los países basado en CP1.
Un índice alto indica una coordenada alta en la dirección elegida para CP1; no significa necesariamente que el país obtenga mejores resultados en todas las variables. El signo de una componente principal es arbitrario: multiplicar el vector propio por \(-1\) cambia los signos de todas las coordenadas sin alterar la solución matemática. Por ello, la interpretación práctica debe acompañarse de las contribuciones y coordenadas de las variables.
10 Gráficas obtenidas en el análisis del taller
Las siguientes figuras corresponden a las salidas gráficas
compartidas durante el desarrollo del taller. Para que aparezcan al
tejer el documento, los archivos de imagen deben permanecer en la misma
carpeta que este .Rmd.
Representación simultánea del ACP original.
Representación simultánea del ACP mejorado sin la variable INST.
Contribución de las variables a la primera dimensión.
Contribución de las variables a la segunda dimensión.
Índice de los países basado en CP1.
10.1 Valores de referencia observados en las salidas del taller
En la salida compartida para el ACP original, la inercia acumulada
del primer plano factorial fue de 66.0159%. En el ACP
mejorado al retirar INST, la primera componente explicó
50.1001% y la segunda 24.0992%, para
una inercia acumulada de 74.1993%.
La mejora absoluta es
\[ 74.1993-66.0159=8.1834 \]
puntos porcentuales. La mejora relativa respecto al modelo original es aproximadamente
\[ 100\frac{74.1993-66.0159}{66.0159}\approx 12.40\%. \]
Estos valores se transcriben de las salidas compartidas; al ejecutar
el documento, deben contrastarse con las tablas que se recalculan en R.
Las gráficas de contribuciones compartidas inicialmente muestran ocho
variables del ACP original, por lo que no deben confundirse con las
contribuciones del ACP mejorado sin INST.
11 Conclusiones
El ACP normado resume la variabilidad de las variables activas en componentes ortogonales. La estandarización permite comparar variables con escalas distintas; la descomposición SVD y la descomposición espectral de la matriz de inercia deben producir valores propios coincidentes. La representación simultánea facilita explorar perfiles de países y relaciones entre variables, siempre reconociendo que se trata de una proyección bidimensional.
La exclusión de INST se evalúa comparando la inercia
acumulada del primer plano con la del modelo original. La tabla de
alternativas y las salidas generadas por R documentan la decisión.
Finalmente, el índice basado en CP1 ordena los países según su posición
relativa en el primer eje del ACP mejorado, y su interpretación depende
del significado estadístico de ese eje.
12 Revisión antes de entregar
- Confirmar que la fila 8 corresponde al individuo suplementario asignado.
- Comparar la tabla de alternativas del punto 5 con el resultado esperado en el enunciado.
- Verificar que el punto 6 utilice siete variables y que
INSThaya sido excluida correctamente. - Revisar las salidas de R y las interpretaciones generadas al tejer el documento.
- No presentar las categorías del índice como clasificaciones absolutas de desarrollo.