planteamiento Un banco dispone de una muestra de 51 entidades financieras que cotizan ciertos derivados financieros cuyo valor en mercado permite estimar la probabilidad de que la empresa quiebre en el plazo de un año y, en caso de quiebra, la tasa de recuperación de la misma. Las empresas observadas también han sido analizadas por dos agencias de calificación externas, que han estimado la probabilidad de quiebra a un año basándose en auditorías realizadas. En la Tabla 7.2 se pueden ver las observaciones de las siguientes variables:

X1 = Nivel crediticio otorgado por el banco internamente a la entidad, X2 = Número de días que ha cotizado en mercado el derivado financiero, X3 = Probabilidad de quiebra deducida del derivado, X4 = Tasa de recuperación deducida del derivado, X5 = Probabilidad de quiebra emitida por la primera agencia externa, X6 = Probabilidad de quiebra emitida por la segunda agencia externa.

Cálcule los ponderadores para un Indicador Multivariado Sintético, que muestre el estado de la salud financiera del banco estudiado. Correlación de las variables con la salud financiera del Banco: X1 (-) X2 (+) X3 (-) X4 (+) X5 (-) X6 (-)

1. 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

2. normalizacion de 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

3. matriz de correlacion y pruebas de narlett y KMO

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

# SI ESTAN MARCADAS SON SIGNIFICATIVAS, COMO HAY VARIAS EXISTE BASTANTE CORRELACION.
#KMO
library(rela)
KMO<-paf(as.matrix(datos_financieros_normalizados))$KMO
print(KMO)
## [1] 0.71477
# como minimo debe de ser 0.5, es mejor si es mas cercano a 1, es mas util para el analisis.
#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
# el p-value da 0, es menor al nivel de significancia, la matriz de correlacion es distinta a la matriz identidad, se rechaza la hipotesis, es decir que tenemos datos significativos.

4. 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

grafico de sedimentacion

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 con 2 factores rotada**

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

graficamente

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)

hasta se calcula los ponderadores de los factores

5. Extraccion de los ponderadores.

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 
# el prop.table toma un elemento y lo divide entre la suma de todos los demas elementos

propuesta para ponderaciones de variables

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