El código R a continuación genera tres de las tablas solicitadas en el enunciado:

  1. Tabla de componentes, con N° del componente, valor propio, porcentaje de variación explicada, y porcentaje de variación acumulada. (25 puntos)
  2. Matriz de variables y componentes principales. (25 puntos)
  3. Matriz de correlaciones entre variables y componentes principales. (25 puntos)

La cuarta tabla del enunciado: interpretación de los componentes principales, está sujeta a la interpretación humana de cada uno/a, y por ende no existe una solución única generable por código R.

La presente pauta de solución está hecha con los datos de Elizabeth Trinidad Camus Mendez. Si alguien desea que la genere nuevamente con sus datos, encantado lo haré.

# Paquetes
library(openxlsx)
library(data.table)
library(gt)
library(ggplot2)

# Parámetros
ruta.datos = "../Evaluaciones/E3/Datos Estudiantes/"
pk = c("ID", "Country", "Year")

# Cargar tabla de observaciones en data frame
df_bancomundial = as.data.frame(fread(paste0(ruta.datos, nombre, ".csv"), header = T, sep = "|"))

# Eliminar filas con valores nulos y extraer matriz estandarizada
df_bancomundial = df_bancomundial[complete.cases(df_bancomundial), ]
X = df_bancomundial[, setdiff(names(df_bancomundial), pk)]
X = scale(X)

# Extraer matriz de varianzas y covarianzas
S = cov(X)

# 1. Tabla de componentes y valores propios
nv = nrow(S)
df_valores_propios = data.frame(Componente = 1:nv, Valor.Propio = eigen(S)$values)
total.valores.propios = sum(df_valores_propios$Valor.Propio)
df_valores_propios$Pct.Variacion = df_valores_propios$Valor.Propio / total.valores.propios
df_valores_propios$Pct.Variacion.Acumulada = NA
df_valores_propios$Pct.Variacion.Acumulada[1] = df_valores_propios$Pct.Variacion[1]
for (j in 2:nv){
  df_valores_propios$Pct.Variacion.Acumulada[j] = df_valores_propios$Pct.Variacion[j] + df_valores_propios$Pct.Variacion.Acumulada[j-1]
}

# Calcular cantidad óptima de componentes principales, usando el criterio de que expliquen al menos el 80% de la varianza.
ncp = min(df_valores_propios[df_valores_propios$Pct.Variacion.Acumulada >= 0.8, "Componente"])

# Dar formato de tabla para mostrar
tabla_valores_propios = gt(df_valores_propios)
tabla_valores_propios = tab_header(tabla_valores_propios, title = " Tabla de Componentes y Valores Propios")
tabla_valores_propios = fmt_number(tabla_valores_propios, columns = Valor.Propio, decimals = 5)
tabla_valores_propios = fmt_percent(tabla_valores_propios
                                    , columns = c(Pct.Variacion, Pct.Variacion.Acumulada)
                                    , decimals = 2
                                    )
tabla_valores_propios = cols_label(tabla_valores_propios
                                   , Valor.Propio = "Valor Propio"
                                   , Pct.Variacion = "% Variación"
                                   , Pct.Variacion.Acumulada = "% Variación Acumulada"
                                   )
tabla_valores_propios
Tabla de Componentes y Valores Propios
Componente Valor Propio % Variación % Variación Acumulada
1 12.67520 35.21% 35.21%
2 4.50304 12.51% 47.72%
3 3.45192 9.59% 57.31%
4 2.86864 7.97% 65.27%
5 1.84421 5.12% 70.40%
6 1.69721 4.71% 75.11%
7 1.22424 3.40% 78.51%
8 1.09484 3.04% 81.55%
9 1.02145 2.84% 84.39%
10 0.89785 2.49% 86.89%
11 0.79081 2.20% 89.08%
12 0.57331 1.59% 90.67%
13 0.53999 1.50% 92.17%
14 0.51129 1.42% 93.59%
15 0.41993 1.17% 94.76%
16 0.33769 0.94% 95.70%
17 0.26168 0.73% 96.43%
18 0.23801 0.66% 97.09%
19 0.17139 0.48% 97.56%
20 0.16126 0.45% 98.01%
21 0.13376 0.37% 98.38%
22 0.11345 0.32% 98.70%
23 0.10420 0.29% 98.99%
24 0.08610 0.24% 99.23%
25 0.06660 0.18% 99.41%
26 0.05428 0.15% 99.56%
27 0.04790 0.13% 99.70%
28 0.03179 0.09% 99.78%
29 0.02561 0.07% 99.85%
30 0.01771 0.05% 99.90%
31 0.01570 0.04% 99.95%
32 0.00959 0.03% 99.97%
33 0.00611 0.02% 99.99%
34 0.00186 0.01% 100.00%
35 0.00127 0.00% 100.00%
36 0.00010 0.00% 100.00%

Se observa en la tabla de valores propios que los primeros 8 valores propios concentran más del 80% de la varianza. Por lo tanto, aplicando este criterio, se eligen 8 componentes principales como un valor óptimo.

# 2. Matriz de variables y componentes principales
df_componentes = data.frame(Variable = row.names(S))
for (i in 1:ncp){
  Rtxt = paste0("df_componentes$CP", i, " = eigen(S)$vectors[, ", i, "]")
  eval(parse(text = Rtxt))
}
tabla_componentes = gt(df_componentes)
tabla_componentes = tab_header(tabla_componentes, title = " Tabla de Componentes Principales")
tabla_componentes = fmt_number(tabla_componentes, columns = 2:(ncp+1), decimals = 3)
tabla_componentes
Tabla de Componentes Principales
Variable CP1 CP2 CP3 CP4 CP5 CP6 CP7 CP8
GDP.capita.growth 0.079 0.141 −0.202 0.065 0.456 0.305 −0.235 −0.165
GDP.growth 0.133 0.150 −0.103 0.067 0.407 0.281 −0.253 −0.154
GDP −0.173 −0.212 0.269 0.057 0.183 −0.030 0.085 −0.149
GDP.capita −0.237 −0.039 0.189 0.165 0.080 0.025 0.021 −0.047
GDP.capita.ppp −0.253 −0.092 0.112 0.055 0.071 0.005 −0.054 0.004
Gov.exp.edu.pct −0.125 0.122 −0.150 −0.080 −0.189 −0.100 0.315 −0.169
Edu.tertiary −0.112 −0.196 −0.173 −0.310 −0.079 0.095 −0.219 0.074
Literacy −0.192 0.112 −0.124 −0.181 0.084 −0.029 −0.022 0.075
Child.no.school 0.168 −0.173 0.174 0.099 −0.107 0.205 −0.077 0.107
Population.density 0.050 −0.107 −0.040 0.311 0.249 −0.269 −0.093 0.047
PM2.5.air.pollution 0.089 −0.023 −0.021 −0.089 −0.003 −0.101 0.199 −0.664
Surface.area −0.037 −0.260 0.026 −0.379 0.228 0.017 0.176 0.159
Inflation 0.054 −0.195 −0.144 −0.050 −0.154 0.144 −0.140 −0.050
Health.expenditure −0.195 0.107 0.075 −0.079 −0.155 0.279 −0.112 −0.232
Health.expenditure.capita −0.254 −0.045 0.169 0.095 −0.013 0.051 −0.113 −0.082
Health.expenditure.gov −0.235 0.096 0.100 −0.043 −0.036 0.084 0.086 −0.098
Health.expenditure.gov.capita −0.246 −0.052 0.195 0.111 0.013 0.040 −0.035 −0.097
Physicians −0.221 −0.104 −0.124 −0.114 0.027 0.232 −0.153 −0.040
Life.expectancy −0.223 0.146 −0.096 0.045 0.098 −0.274 −0.104 −0.097
Prob.death.5-9 0.200 −0.153 0.213 0.087 −0.113 0.253 0.038 0.081
Suicide.rate −0.072 −0.148 −0.253 −0.208 0.108 0.233 0.275 0.217
Undernourishment 0.176 0.039 0.192 −0.015 −0.019 0.185 0.067 −0.015
Population.growth 0.179 0.036 0.305 0.004 −0.124 −0.060 −0.066 0.024
Population 0.068 −0.315 0.170 0.038 0.221 −0.109 −0.063 0.072
Broadband.access −0.217 −0.090 0.009 0.031 −0.212 0.022 −0.333 0.095
Internet.use −0.200 −0.020 0.045 −0.075 −0.190 −0.107 −0.373 0.115
Patents −0.123 −0.292 0.079 −0.256 0.212 −0.008 0.187 0.015
Publications −0.199 −0.193 0.227 0.051 0.115 0.011 0.092 −0.162
Corruption −0.185 0.173 −0.064 0.200 −0.048 0.182 0.149 0.237
Governance −0.172 0.182 −0.037 0.247 0.007 0.095 0.294 0.228
Democracy −0.165 0.176 0.110 0.167 0.222 0.132 0.151 0.208
Gini 0.040 0.298 0.259 −0.312 0.093 −0.064 −0.047 0.088
Income.highest.10pct 0.058 0.296 0.233 −0.303 0.092 −0.103 −0.012 0.092
Income.lowest.10pct 0.050 −0.282 −0.287 0.266 −0.081 −0.047 0.108 −0.014
Extreme.poverty 0.199 −0.034 0.223 0.021 −0.079 0.270 0.056 −0.001
Unemployment −0.100 0.054 −0.012 −0.018 −0.194 0.336 0.133 −0.190
 
# Matriz de correlaciones entre variables y componentes principales
E = df_componentes[, setdiff(names(df_componentes), "Variable")]
E = as.matrix(E)
Y = X %*% E
Z = cbind(X,Y)
R = -cor(Z)
R = R[1:36, 37:(36+ncp)]
df_componentes_correlacion = as.data.frame(R)
df_componentes_correlacion$Variable = row.names(df_componentes_correlacion)
nc = ncol(df_componentes_correlacion)
df_componentes_correlacion = df_componentes_correlacion[, c(nc, 1:(nc-1))]
tabla_componentes_correlacion = gt(df_componentes_correlacion)
tabla_componentes_correlacion = tab_header(tabla_componentes_correlacion, title = " Matriz de Correlaciones entre Variables y Componentes Principales")
tabla_componentes_correlacion = fmt_number(tabla_componentes_correlacion, columns = 2:(ncp+1), decimals = 2)
tabla_componentes_correlacion
Matriz de Correlaciones entre Variables y Componentes Principales
Variable CP1 CP2 CP3 CP4 CP5 CP6 CP7 CP8
GDP.capita.growth −0.28 −0.30 0.37 −0.11 −0.62 −0.40 0.26 0.17
GDP.growth −0.47 −0.32 0.19 −0.11 −0.55 −0.37 0.28 0.16
GDP 0.62 0.45 −0.50 −0.10 −0.25 0.04 −0.09 0.16
GDP.capita 0.84 0.08 −0.35 −0.28 −0.11 −0.03 −0.02 0.05
GDP.capita.ppp 0.90 0.20 −0.21 −0.09 −0.10 −0.01 0.06 0.00
Gov.exp.edu.pct 0.44 −0.26 0.28 0.14 0.26 0.13 −0.35 0.18
Edu.tertiary 0.40 0.42 0.32 0.53 0.11 −0.12 0.24 −0.08
Literacy 0.68 −0.24 0.23 0.31 −0.11 0.04 0.02 −0.08
Child.no.school −0.60 0.37 −0.32 −0.17 0.15 −0.27 0.09 −0.11
Population.density −0.18 0.23 0.07 −0.53 −0.34 0.35 0.10 −0.05
PM2.5.air.pollution −0.32 0.05 0.04 0.15 0.00 0.13 −0.22 0.69
Surface.area 0.13 0.55 −0.05 0.64 −0.31 −0.02 −0.19 −0.17
Inflation −0.19 0.41 0.27 0.08 0.21 −0.19 0.15 0.05
Health.expenditure 0.69 −0.23 −0.14 0.13 0.21 −0.36 0.12 0.24
Health.expenditure.capita 0.90 0.09 −0.31 −0.16 0.02 −0.07 0.12 0.09
Health.expenditure.gov 0.84 −0.20 −0.19 0.07 0.05 −0.11 −0.10 0.10
Health.expenditure.gov.capita 0.88 0.11 −0.36 −0.19 −0.02 −0.05 0.04 0.10
Physicians 0.79 0.22 0.23 0.19 −0.04 −0.30 0.17 0.04
Life.expectancy 0.79 −0.31 0.18 −0.08 −0.13 0.36 0.12 0.10
Prob.death.5-9 −0.71 0.33 −0.40 −0.15 0.15 −0.33 −0.04 −0.08
Suicide.rate 0.26 0.31 0.47 0.35 −0.15 −0.30 −0.30 −0.23
Undernourishment −0.63 −0.08 −0.36 0.02 0.03 −0.24 −0.07 0.02
Population.growth −0.64 −0.08 −0.57 −0.01 0.17 0.08 0.07 −0.03
Population −0.24 0.67 −0.32 −0.07 −0.30 0.14 0.07 −0.08
Broadband.access 0.77 0.19 −0.02 −0.05 0.29 −0.03 0.37 −0.10
Internet.use 0.71 0.04 −0.08 0.13 0.26 0.14 0.41 −0.12
Patents 0.44 0.62 −0.15 0.43 −0.29 0.01 −0.21 −0.02
Publications 0.71 0.41 −0.42 −0.09 −0.16 −0.01 −0.10 0.17
Corruption 0.66 −0.37 0.12 −0.34 0.07 −0.24 −0.16 −0.25
Governance 0.61 −0.39 0.07 −0.42 −0.01 −0.12 −0.33 −0.24
Democracy 0.59 −0.37 −0.20 −0.28 −0.30 −0.17 −0.17 −0.22
Gini −0.14 −0.63 −0.48 0.53 −0.13 0.08 0.05 −0.09
Income.highest.10pct −0.21 −0.63 −0.43 0.51 −0.13 0.13 0.01 −0.10
Income.lowest.10pct −0.18 0.60 0.53 −0.45 0.11 0.06 −0.12 0.02
Extreme.poverty −0.71 0.07 −0.41 −0.04 0.11 −0.35 −0.06 0.00
Unemployment 0.36 −0.11 0.02 0.03 0.26 −0.44 −0.15 0.20

———————————————————————-