INDICADOR MULTIVARIADO SINTETICO

Including Plots

You can also embed plots, for example:

Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.

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)

## Warning: `read_table2()` was deprecated in readr 2.0.0.
## Please use `read_table()` instead.

## 
## -- Column specification --------------------------------------------------------
## cols(
##   X1 = col_double(),
##   X2 = col_double(),
##   X3 = col_double(),
##   X4 = col_double(),
##   X5 = col_double(),
##   X6 = col_double()
## )

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

NORMALIZACION DE LOS DATOS

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

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 CORRELACION Y PRUEBAS DE BARLETT Y KMO

##MATRIZ DE CORRELACION Y PRUEBAS DE BARLETT Y KMO
#Matriz de correlación
library(PerformanceAnalytics)

## Loading required package: xts

## Loading required package: zoo

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

## 
## Attaching package: 'xts'

## The following objects are masked from 'package:dplyr':
## 
##     first, last

## 
## Attaching package: 'PerformanceAnalytics'

## The following object is masked from 'package:graphics':
## 
##     legend

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

#Prueba de Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(datos_financieros_normalizados)

## R was not square, finding R from data

print(Barlett)

## $chisq
## [1] 295.14
## 
## $p.value
## [1] 0.0000000000000000000000000000000000000000000000000000057222
## 
## $df
## [1] 15

ANALISIS FACTORIAL

##ANALISIS FACTORIAL
library(FactoMineR)
library(factoextra)

## Loading required package: ggplot2

## 
## Attaching package: 'ggplot2'

## The following objects are masked from 'package:psych':
## 
##     %+%, alpha

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

library(kableExtra)

## 
## Attaching package: 'kableExtra'

## The following object is masked from 'package:dplyr':
## 
##     group_rows

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)

library(corrplot)

## corrplot 0.90 loaded

#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

INDICADOR MULTIVARIADO SINTETICO

Jefferson Quintanilla

23/10/2021

R Markdown

Including Plots