Planteamiento del Ejercicio

Ejercicio Adaptado de Moreno, A. B., & Chávez, A. G. (2007). 100 problemas resueltos de estadística multivariante. Delta Publicaciones. ver texto https://books.google.com.sv/books?id=mejciP3IAygC&pg=PA136&dq=100+ejercicios+de+estadistica+multivariante+problema+7.5&hl=es-419&sa=X&ved=2ahUKEwiyrMW5xNvsAhVGu1kKHejGD1AQ6AEwAHoECAEQAg#v=onepage&q=100%20ejercicios%20de%20estadistica%20multivariante%20problema%207.5&f=false

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 (-)

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 × 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.00056  0.39 0.00041 0.00003
## 3   8.1   630 0.00049  0.4  0.00041 0.00003
## 4   7.5   630 0.0006   0.39 0.00041 0.00026
## 5   7.5   630 0.00047  0.4  0.00041 0.00026
## 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
#"Select(X2,X4)" para que seleccione esas 2 columnas que son las que tiennen correlacion positiva 
#"apply(MARGIN=2"...) para que le aplique a todas las columnas
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 (para unir los dos dataframe)

#"bind_cols" para unir columnas
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

Obtener la Matriz de Correlación & Pruebas de Barlett y KMO (para verificar si los datos satisfacen los supuestos del analisis factorial)

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

- A simple vista vemos que la gran mayoria de correlacion son significativas al 1% (***). - Hay evidente correlacion entre las variables propuestas en la bateria de indicadores.

#KMO
library(rela)
KMO<-paf(as.matrix(datos_financieros_normalizados))$KMO
print(KMO)
## [1] 0.71477
#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

Se recha Ho ya que p-value< nivel de significancia (5%). Por lo tanto, hay evidencia de correlacion poblacional entre la bateria de indicadores propuesta.

Se satisfacen los supuestos

ANÁLISIS FACTORIAL

library(FactoMineR)
library(factoextra)
library(kableExtra)

#CALCULO DE LA MATRIZ DE CORRELACION (version numerica)
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

PARA MEJORAR NUESTRA ELEECION- OBTENER EL GRAFICO DE SEDIMENTACION Criterio de el bong

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)

Este criterio tambien converge en que 2 componentes se deben retener. Entonces solo probaremos una solucion

Modelo de 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

Para la 1ra variable (X1) el 76% (h2=0.76) de su varianza es explicada por la solucion (por la extraccion) y asi para las demas varibles.

Entinces, esta es una solucion bastante representativa de los datos originales. o sea, perdemos muy poco informacion al sustituir la bateria original de indicadorres por las dos componentes qye hemos estimado.

PONDERADORES DE ESOS DOS COMPONENTES QUE HEMOS EXTRAIDO Proportion Explained RC1=0.65, RC2=0.35 Cunaod construyamos nuestro indicador, la 1er variable latente que construyamos va a tener un poderador de 0.65 y la otra de 0.35.

GRÁFICO PARA VER QUE VARIABLES QUEDAN REPRESENTADAS EN CADA FACTOR

correlaciones_modelo<-variables_pca$coord

#Para extraer las componente rotadas hayq ue volverlas a calcular de manera manual
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)

- Para la variable latente 1 queda representada X1,X3,X4,X6. Estas 4 variables estarian representadas por la dimension 1. -La dimension 2 esta mas asociada con X2 y X5.

Aca podemos estar totalmente seguros que esa seria la clasficiacion que deberiamos hacer.

Ponderadores de los Factores Extraídos

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

Contribución de las variables en los Factores

Ponderadores de cada una de las variables originales dentro de cada una de las variables latentes.

PESOS DE CADA UNA DE LAS 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

Tener en cuenta uno de los planteamientos del analisis factorial y es que si bien es cierto la primera dimension representas +4 variables pero se construye con la informacion de toda la bateria de indicadores. Se construye con toda la informacion pero es representativa de un subconjunto de las variables.

Por eso aca, al moemnto de constriur las variables latentes vamos a obtener ponderados para todas y no solo para las que se incluyen .

HASTA AQUI HEMOS RESUELTO EL PROBLEMA DE INDICADOR SINTETICO PERO AUN NO HEMOS OBTENIDO EL INDICADOR SINTETICO