carga de datos

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

Normalización 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 correlación 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 Correlación & Pruebas de Barlett y KMO

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

existe una alta correlacion entre la bateria de indicadores.

calculo del KMO

#KMO
library(rela)
KMO<-paf(as.matrix(datos_financieros_normalizados))$KMO
print(KMO)
## [1] 0.71477

Calculo de la prueba de Barlet

#Prueba de Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(datos_financieros_normalizados)
print(Barlett)
## $chisq
## [1] 295.14
## 
## $p.value
## [1] 0.0000000000000000000000000000000000000000000000000000057222
## 
## $df
## [1] 15

Análisis Factorial

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 = "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)

Extraccion

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

las variables se encuentran adecudamente representadas con la extraccion.

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