# Cargar librerías
library(dplyr)
library(readr)
library(PerformanceAnalytics)
library(psych)
library(FactoMineR)
library(factoextra)
library(kableExtra)
library(corrplot)Ejemplo
# Cargar archivo CSV
ejemplo <- read_delim("C:/Users/dfuentes/Downloads/inversion_clima_consolidado_2009_2024_con_fuentes_macro.csv",
delim = ",",
locale = locale(decimal_mark = ".", grouping_mark = ""))Rows: 18 Columns: 15
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (13): Year, GDP Real (%), Inflation (%), CPI Score (0-100), GII Rank, Do...
dbl (2): Tasa de Interes Empresarial promedio ponderada, Impuestos sobre la...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.ejemplo <- ejemplo[,2:ncol(ejemplo)]
ejemplo <- ejemplo[1:(nrow(ejemplo)-2), ]
ejemplo[] <- lapply(ejemplo, function(x) as.numeric(as.character(x)))
str(ejemplo)tibble [16 × 14] (S3: tbl_df/tbl/data.frame)
$ GDP Real (%) : num [1:16] -2.1 2.1 3.8 2.8 2.2 1.7 2.4 2.5 2.3 2.4 ...
$ Inflation (%) : num [1:16] 0.5 1.2 5.1 1.7 0.8 1.1 -0.7 0.6 1 1.1 ...
$ CPI Score (0-100) : num [1:16] 35 36 34 38 38 39 39 36 33 35 ...
$ GII Rank : num [1:16] 93 93 104 98 102 96 96 91 85 82 ...
$ Doing Business Rank : num [1:16] 91 85 83 80 77 72 67 68 75 99 ...
$ WGI Control of Corruption : num [1:16] -0.23 -0.26 -0.28 -0.3 -0.32 -0.34 -0.36 -0.38 -0.4 -0.42 ...
$ WGI Regulatory Quality : num [1:16] -0.1 -0.15 -0.18 -0.2 -0.22 -0.25 -0.27 -0.29 -0.3 -0.25 ...
$ E-Government rank : num [1:16] 74 73 80.5 88 96 ...
$ LPI Score : num [1:16] 2.5 2.53 2.6 2.62 2.7 2.71 2.7 2.62 2.8 2.69 ...
$ HDI : num [1:16] 0.62 0.63 0.64 0.65 0.66 0.67 0.68 0.69 0.695 0.668 ...
$ Mean Years of Schooling : num [1:16] 9.5 9.7 9.9 10.1 10.3 10.5 10.6 10.7 10.8 10.9 ...
$ GCI Rank : num [1:16] 70 75 80 85 90 95 97 100 105 110 ...
$ Tasa de Interes Empresarial promedio ponderada : num [1:16] 8 9 8 7 7 8 8 8 8 8 ...
$ Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación: num [1:16] 34 32 30 29 29 33 32 36 34 34 ...head(ejemplo)# A tibble: 6 × 14
`GDP Real (%)` `Inflation (%)` `CPI Score (0-100)` `GII Rank`
<dbl> <dbl> <dbl> <dbl>
1 -2.1 0.5 35 93
2 2.1 1.2 36 93
3 3.8 5.1 34 104
4 2.8 1.7 38 98
5 2.2 0.8 38 102
6 1.7 1.1 39 96
# ℹ 10 more variables: `Doing Business Rank` <dbl>,
# `WGI Control of Corruption` <dbl>, `WGI Regulatory Quality` <dbl>,
# `E-Government rank` <dbl>, `LPI Score` <dbl>, HDI <dbl>,
# `Mean Years of Schooling` <dbl>, `GCI Rank` <dbl>,
# `Tasa de Interes Empresarial promedio ponderada` <dbl>,
# `Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación` <dbl># Normalización de Datos usando across y los helpers
norm_directa <- function(x) (x - min(x)) / (max(x) - min(x))
norm_inversa <- function(x) (max(x) - x) / (max(x) - min(x))
df <- ejemplo
nombres_originales <- names(df)
tipo_correlacion <- c("directa", "inversa", "directa", "directa", "directa", "directa", "directa", "directa", "directa", "directa", "directa", "directa", "inversa", "inversa")
names(df) <- paste0(names(df), "_", tipo_correlacion)
df <- df |>
mutate(across(matches("_directa$"), norm_directa)) |>
mutate(across(matches("_inversa$"), norm_inversa))
names(df) <- nombres_originales
datos_financieros_normalizados <- df
head(datos_financieros_normalizados)# A tibble: 6 × 14
`GDP Real (%)` `Inflation (%)` `CPI Score (0-100)` `GII Rank`
<dbl> <dbl> <dbl> <dbl>
1 0.293 0.848 0.636 0.56
2 0.505 0.759 0.727 0.56
3 0.591 0.266 0.545 1
4 0.540 0.696 0.909 0.76
5 0.510 0.810 0.909 0.92
6 0.485 0.772 1 0.68
# ℹ 10 more variables: `Doing Business Rank` <dbl>,
# `WGI Control of Corruption` <dbl>, `WGI Regulatory Quality` <dbl>,
# `E-Government rank` <dbl>, `LPI Score` <dbl>, HDI <dbl>,
# `Mean Years of Schooling` <dbl>, `GCI Rank` <dbl>,
# `Tasa de Interes Empresarial promedio ponderada` <dbl>,
# `Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación` <dbl>#Matriz de Correlación & Pruebas de Barlett y KMO
chart.Correlation(select_if(datos_financieros_normalizados, is.numeric), histogram = TRUE, pch = 12)#KMO
datos_kmo <- select_if(datos_financieros_normalizados, is.numeric)
# Paso 1: Eliminar columnas constantes (sin variación)
datos_kmo <- datos_kmo[ , sapply(datos_kmo, function(x) length(unique(x)) > 1)]
# Paso 2: Eliminar columnas duplicadas
datos_kmo <- datos_kmo[ , !duplicated(t(datos_kmo))]
# Paso 3: Verifica correlaciones perfectas
cor_mat <- cor(datos_kmo, use = "pairwise.complete.obs")
# Si tienes correlaciones de 1 o -1 fuera de la diagonal, identifica variables problemáticas:
diag(cor_mat) <- NA # ignora la diagonal
which(abs(cor_mat) == 1, arr.ind = TRUE) row col# Vuelve a calcular el KMO
KMO_resultado <- KMO(cor(datos_kmo, use = "pairwise.complete.obs"))
print(KMO_resultado)Kaiser-Meyer-Olkin factor adequacy
Call: KMO(r = cor(datos_kmo, use = "pairwise.complete.obs"))
Overall MSA = 0.32
MSA for each item =
GDP Real (%)
0.11
Inflation (%)
0.17
CPI Score (0-100)
0.18
GII Rank
0.16
Doing Business Rank
0.11
WGI Control of Corruption
0.41
WGI Regulatory Quality
0.62
E-Government rank
0.45
LPI Score
0.40
HDI
0.55
Mean Years of Schooling
0.58
GCI Rank
0.22
Tasa de Interes Empresarial promedio ponderada
0.09
Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación
0.20 #Prueba de Barlett options(scipen = 99999)
Barlett <- cortest.bartlett(cor(datos_kmo, use="pairwise.complete.obs"), n = nrow(datos_kmo))
print(Barlett)$chisq
[1] 233.4565
$p.value
[1] 1.777603e-14
$df
[1] 91##La Prueba de Esfericidad de Bartlett se usa para evaluar si la matriz de correlación de las variables es significativamente diferente de una matriz identidad (es decir, si hay correlaciones significativas entre las variables
#Análisis Factorial
Rx<-cor(datos_financieros_normalizados)
PC<-prcomp(datos_financieros_normalizados, scale. = TRUE)
variables_pca<-get_pca_var(PC)
factoextra::get_eig(PC) %>% kable(caption="Resumen de PCA",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("hover"))| eigenvalue | variance.percent | cumulative.variance.percent | |
|---|---|---|---|
| Dim.1 | 5.94 | 42.45 | 42.45 |
| Dim.2 | 2.60 | 18.58 | 61.03 |
| Dim.3 | 2.12 | 15.13 | 76.16 |
| Dim.4 | 1.13 | 8.08 | 84.24 |
| Dim.5 | 0.85 | 6.08 | 90.32 |
| Dim.6 | 0.56 | 3.98 | 94.30 |
| Dim.7 | 0.37 | 2.62 | 96.93 |
| Dim.8 | 0.19 | 1.38 | 98.30 |
| Dim.9 | 0.14 | 1.02 | 99.33 |
| Dim.10 | 0.05 | 0.34 | 99.66 |
| Dim.11 | 0.03 | 0.21 | 99.87 |
| Dim.12 | 0.01 | 0.08 | 99.96 |
| Dim.13 | 0.00 | 0.03 | 99.99 |
| Dim.14 | 0.00 | 0.01 | 100.00 |
fviz_eig(PC,
choice = "eigenvalue",
barcolor = "red",
barfill = "red",
addlabels = TRUE,
)+labs(title = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
xlab(label = "Componentes")+
ylab(label = "Autovalores")+geom_hline(yintercept = 1)
#Modelo de 2 Factores (Rotada)
numero_de_factores<-2
modelo_factores<-principal(r = Rx,
nfactors = numero_de_factores,
covar = FALSE,
rotate = "varimax")
modelo_factoresPrincipal Components Analysis
Call: principal(r = Rx, nfactors = numero_de_factores, rotate = "varimax",
covar = FALSE)
Standardized loadings (pattern matrix) based upon correlation matrix
RC1
GDP Real (%) 0.18
Inflation (%) -0.09
CPI Score (0-100) -0.34
GII Rank -0.33
Doing Business Rank -0.13
WGI Control of Corruption -0.96
WGI Regulatory Quality -0.97
E-Government rank 0.90
LPI Score 0.87
HDI 0.94
Mean Years of Schooling 0.96
GCI Rank 0.50
Tasa de Interes Empresarial promedio ponderada 0.08
Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación -0.40
RC2
GDP Real (%) -0.67
Inflation (%) 0.80
CPI Score (0-100) 0.54
GII Rank -0.74
Doing Business Rank 0.34
WGI Control of Corruption 0.11
WGI Regulatory Quality 0.15
E-Government rank -0.07
LPI Score -0.04
HDI 0.10
Mean Years of Schooling 0.04
GCI Rank 0.39
Tasa de Interes Empresarial promedio ponderada 0.11
Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación -0.59
h2
GDP Real (%) 0.480
Inflation (%) 0.654
CPI Score (0-100) 0.404
GII Rank 0.651
Doing Business Rank 0.129
WGI Control of Corruption 0.931
WGI Regulatory Quality 0.965
E-Government rank 0.817
LPI Score 0.764
HDI 0.896
Mean Years of Schooling 0.922
GCI Rank 0.409
Tasa de Interes Empresarial promedio ponderada 0.019
Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación 0.504
u2
GDP Real (%) 0.520
Inflation (%) 0.346
CPI Score (0-100) 0.596
GII Rank 0.349
Doing Business Rank 0.871
WGI Control of Corruption 0.069
WGI Regulatory Quality 0.035
E-Government rank 0.183
LPI Score 0.236
HDI 0.104
Mean Years of Schooling 0.078
GCI Rank 0.591
Tasa de Interes Empresarial promedio ponderada 0.981
Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación 0.496
com
GDP Real (%) 1.1
Inflation (%) 1.0
CPI Score (0-100) 1.7
GII Rank 1.4
Doing Business Rank 1.3
WGI Control of Corruption 1.0
WGI Regulatory Quality 1.0
E-Government rank 1.0
LPI Score 1.0
HDI 1.0
Mean Years of Schooling 1.0
GCI Rank 1.9
Tasa de Interes Empresarial promedio ponderada 1.7
Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación 1.8
RC1 RC2
SS loadings 5.94 2.60
Proportion Var 0.42 0.19
Cumulative Var 0.42 0.61
Proportion Explained 0.70 0.30
Cumulative Proportion 0.70 1.00
Mean item complexity = 1.3
Test of the hypothesis that 2 components are sufficient.
The root mean square of the residuals (RMSR) is 0.14
Fit based upon off diagonal values = 0.89correlaciones_modelo<-variables_pca$coord
rotacion<-varimax(correlaciones_modelo[,1:numero_de_factores])
correlaciones_modelo_rotada<-rotacion$loadingscorrplot(correlaciones_modelo_rotada[, 1:numero_de_factores],
is.corr = FALSE,
method = "square",
addCoef.col = "grey",
number.cex = 0.75,
tl.cex = 0.75)
cargas<-rotacion$loadings[1:14,1:numero_de_factores]
ponderadores<-prop.table(apply(cargas^2,MARGIN = 2,sum))
t(ponderadores) %>% kable(caption="Ponderadores de los Factores Extraídos",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| Dim.1 | Dim.2 |
|---|---|
| 0.7 | 0.3 |
contribuciones<-apply(cargas^2,MARGIN = 2,prop.table)
contribuciones %>% kable(caption="Contribución de las variables en los Factores",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| Dim.1 | Dim.2 | |
|---|---|---|
| GDP Real (%) | 0.01 | 0.17 |
| Inflation (%) | 0.00 | 0.25 |
| CPI Score (0-100) | 0.02 | 0.11 |
| GII Rank | 0.02 | 0.21 |
| Doing Business Rank | 0.00 | 0.04 |
| WGI Control of Corruption | 0.15 | 0.00 |
| WGI Regulatory Quality | 0.16 | 0.01 |
| E-Government rank | 0.14 | 0.00 |
| LPI Score | 0.13 | 0.00 |
| HDI | 0.15 | 0.00 |
| Mean Years of Schooling | 0.15 | 0.00 |
| GCI Rank | 0.04 | 0.06 |
| Tasa de Interes Empresarial promedio ponderada | 0.00 | 0.01 |
| Impuestos sobre la renta las utilidades y las ganancias de capital porcentaje de la recaudación | 0.03 | 0.13 |
# Construcción del Indicador Sintético Multivariado (ISM)
# cargas y pesos
loads_mat <- PC$rotation[, 1:2]
pesos <- c(0.7, 0.3)
# nombres de las variables que usaste en prcomp
vars_pca <- rownames(loads_mat)
datos_kmo <- datos_kmo %>%
mutate(
ISM = {
# Selecciono sólo las columnas que corresponden a vars_pca,
# las convierto a matriz y las multiplico
x <- select(., all_of(vars_pca)) %>% as.matrix()
rowSums( x %*% loads_mat %*% diag(pesos) )
},
ISM_norm = (ISM - min(ISM)) / (max(ISM) - min(ISM))
)
ISM <- datos_kmo$ISM # Visualizar el ISM
head(ISM)[1] -0.56959271 -0.44749804 -0.40503195 -0.09987886 0.13703082 0.50451089# Gráfico del Indicador Sintético
library(ggplot2)
# 1) Precalcula el índice de observación
datos_kmo <- datos_kmo %>%
mutate(obs = row_number())
# 2) Ya puedes usar obs en ggplot sin líos
ggplot(datos_kmo, aes(x = obs, y = ISM_norm)) +
geom_line(color = "blue") +
labs(
title = "Indicador Sintético Multivariado",
x = "Observación",
y = "ISM Normalizado"
) +
theme_minimal()