Ejemplo Indicador Miltivariado Sintetico

library(readr)
nombre_archivo<-"http://halweb.uc3m.es/esp/Personal/personas/agrane/libro/ficheros_datos/capitulo_7/entidades_financieras.txt"
datos_financieros<-read_table2(nombre_archivo,col_names = FALSE)
head(datos_financieros)
## # A tibble: 6 x 6
##      X1    X2       X3    X4      X5       X6
##   <dbl> <dbl>    <dbl> <dbl>   <dbl>    <dbl>
## 1   7.6   630 0.0007    0.36 0.00041 0.00003 
## 2   7.8   630 0.000560  0.39 0.00041 0.00003 
## 3   8.1   630 0.00049   0.4  0.00041 0.00003 
## 4   7.5   630 0.000600  0.39 0.00041 0.000260
## 5   7.5   630 0.00047   0.4  0.00041 0.000260
## 6   8.3   630 0.00055   0.4  0.00041 0.00019

Normalizacion de los Datos

library(dplyr)
norm_directa<-function(x){(x-min(x))/(max(x)-min(x))}
norm_inversa<-function(x){(max(x)-x)/(max(x)-min(x))}
#Seleccionando las variables con correlacion positiva para la Salud Financiera
datos_financieros %>%
  select(X2,X4) %>%
  apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->variables_corr_positiva
#Seleccionando las variables con correlación negativa para la Salud Financiera
datos_financieros %>% 
  select(X1,X3,X5,X6) %>% 
  apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()->variables_corr_negativa
#Juntando y reordenando las variables
variables_corr_positiva %>% 
  bind_cols(variables_corr_negativa) %>% 
  select(X1,X2,X3,X4,X5,X6)->datos_financieros_normalizados
head(datos_financieros_normalizados)
##          X1 X2        X3        X4        X5        X6
## 1 0.4285714  1 0.8779221 0.2857143 0.9366306 0.9961538
## 2 0.3714286  1 0.9142857 0.5000000 0.9366306 0.9961538
## 3 0.2857143  1 0.9324675 0.5714286 0.9366306 0.9961538
## 4 0.4571429  1 0.9038961 0.5000000 0.9366306 0.9666667
## 5 0.4571429  1 0.9376623 0.5714286 0.9366306 0.9666667
## 6 0.2285714  1 0.9168831 0.5714286 0.9366306 0.9756410

Matriz de Correlacion & Pruebas de Barlett y KMO

#Matriz de correlacion 
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_financieros_normalizados),histogram = TRUE,pch=12)

#KMO
library(rela)
KMO<-paf(as.matrix(datos_financieros_normalizados))$KMO
print(KMO)
## [1] 0.71477
library(psych)
options(scipen = 9999)
Barlett<-cortest.bartlett(datos_financieros_normalizados)
print(Barlett)
## $chisq
## [1] 295.14
## 
## $p.value
## [1] 0.0000000000000000000000000000000000000000000000000000057222
## 
## $df
## [1] 15

Analisis factorial

library(FactoMineR)
library(factoextra)
library(kableExtra)
Rx<-cor(datos_financieros_normalizados)
PC<-princomp(x = datos_financieros_normalizados,cor = TRUE,fix_sign = FALSE)
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"))
Resumen de PCA
eigenvalue variance.percent cumulative.variance.percent
Dim.1 3.88 64.73 64.73
Dim.2 1.16 19.34 84.07
Dim.3 0.58 9.67 93.73
Dim.4 0.24 3.96 97.70
Dim.5 0.11 1.84 99.53
Dim.6 0.03 0.47 100.00 
fviz_eig(PC,
         choice = "eigenvalue",
         barcolor = "blue",
         barfill = "blue",
         addlabels = TRUE, 
       )+labs(title = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+geom_hline(yintercept = 1)

library(corrplot)
#Modelo de 2 Factores (Rotada)
numero_de_factores<-2
modelo_factores<-principal(r = Rx,
                             nfactors = numero_de_factores,
                             covar = FALSE,
                             rotate = "varimax")
modelo_factores
## Principal Components Analysis
## Call: principal(r = Rx, nfactors = numero_de_factores, rotate = "varimax", 
##     covar = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
##      RC1   RC2   h2    u2 com
## X1 -0.86 -0.14 0.76 0.242 1.1
## X2 -0.05  0.88 0.79 0.215 1.0
## X3  0.90  0.35 0.93 0.068 1.3
## X4  0.91 -0.13 0.84 0.160 1.0
## X5  0.61  0.68 0.84 0.165 2.0
## X6  0.74  0.59 0.89 0.107 1.9
## 
##                        RC1  RC2
## SS loadings           3.29 1.76
## Proportion Var        0.55 0.29
## Cumulative Var        0.55 0.84
## Proportion Explained  0.65 0.35
## Cumulative Proportion 0.65 1.00
## 
## Mean item complexity =  1.4
## Test of the hypothesis that 2 components are sufficient.
## 
## The root mean square of the residuals (RMSR) is  0.09 
## 
## Fit based upon off diagonal values = 0.98
correlaciones_modelo<-variables_pca$coord
rotacion<-varimax(correlaciones_modelo[,1:numero_de_factores])
correlaciones_modelo_rotada<-rotacion$loadings

corrplot(correlaciones_modelo_rotada[,1:numero_de_factores],
         is.corr = FALSE,
         method = "square",
         addCoef.col="grey",
         number.cex = 0.75)

library(kableExtra)
cargas<-rotacion$loadings[1:6,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"))
Ponderadores de los Factores Extraídos
Dim.1 Dim.2
0.65 0.35 
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"))
Contribución de las variables en los Factores
Dim.1 Dim.2
X1 0.22 0.01
X2 0.00 0.45
X3 0.25 0.07
X4 0.25 0.01
X5 0.11 0.26
X6 0.16 0.20