Carga de datos
library(dplyr)
library(kableExtra)
load("C:/Users/DELL i5/Desktop/Pablo/Ciclo II 2023/Metodos para analisis/data_desarrollo.RData")
data_indicadores<-data_desarrollo %>%
select(ALFABET, INC_POB, ESPVIDAF, MORTINF, FERTILID, TASA_NAT, LOG_PIB, URBANA, TASA_MOR) %>%
filter(complete.cases(.))
data_indicadores %>%
head() %>%
kable(caption="Tabla sobre el Desarrollo en las Economías.",
align = "c",
digits = 2) %>%
kable_material(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
Tabla sobre el Desarrollo en las Economías.
|
ALFABET
|
INC_POB
|
ESPVIDAF
|
MORTINF
|
FERTILID
|
TASA_NAT
|
LOG_PIB
|
URBANA
|
TASA_MOR
|
|
98
|
1.40
|
75
|
35.0
|
2.80
|
23
|
3.48
|
54
|
7
|
|
29
|
2.80
|
44
|
168.0
|
6.90
|
53
|
2.31
|
18
|
22
|
|
99
|
0.36
|
79
|
6.5
|
1.47
|
11
|
4.24
|
85
|
11
|
|
62
|
3.20
|
70
|
52.0
|
6.67
|
38
|
3.82
|
77
|
6
|
|
95
|
1.30
|
75
|
25.6
|
2.80
|
20
|
3.53
|
86
|
9
|
|
98
|
1.40
|
75
|
27.0
|
3.19
|
23
|
3.70
|
68
|
6
|
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))}
data_indicadores %>%
select(ALFABET, INC_POB, ESPVIDAF, FERTILID, TASA_NAT, LOG_PIB, URBANA) %>%
apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->variables_corr_positiva
data_indicadores %>%
select(MORTINF, TASA_MOR) %>%
apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()->variables_corr_negativa
variables_corr_positiva %>%
bind_cols(variables_corr_negativa) %>%
select(ALFABET, INC_POB, ESPVIDAF, FERTILID, TASA_NAT, LOG_PIB, URBANA, MORTINF, TASA_MOR)->datos_desarrollo_normalizados
datos_desarrollo_normalizados <- datos_desarrollo_normalizados[, apply(datos_desarrollo_normalizados, 2, function(x) all(!is.na(x)))]
head(datos_desarrollo_normalizados)
## ALFABET INC_POB ESPVIDAF FERTILID TASA_NAT LOG_PIB URBANA
## 1 0.9756098 0.3068592 0.82051282 0.21770682 0.30232558 0.60885423 0.5157895
## 2 0.1341463 0.5595668 0.02564103 0.81277213 1.00000000 0.09867408 0.1368421
## 3 0.9878049 0.1191336 0.92307692 0.02467344 0.02325581 0.94458420 0.8421053
## 4 0.5365854 0.6317690 0.69230769 0.77939042 0.65116279 0.76022519 0.7578947
## 5 0.9390244 0.2888087 0.82051282 0.21770682 0.23255814 0.63309802 0.8526316
## 6 0.9756098 0.3068592 0.82051282 0.27431060 0.30232558 0.70597624 0.6631579
## MORTINF TASA_MOR
## 1 0.8109756 0.77272727
## 2 0.0000000 0.09090909
## 3 0.9847561 0.59090909
## 4 0.7073171 0.81818182
## 5 0.8682927 0.68181818
## 6 0.8597561 0.81818182
Matriz de Correlación & Pruebas de Barlett y KMO
Matriz de correlacion
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_desarrollo_normalizados),histogram = TRUE,pch=12)
KMO
library(rela)
KMO<-paf(as.matrix(datos_desarrollo_normalizados))$KMO
print(KMO)
## [1] 0.86467
Prueba barlet
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(datos_desarrollo_normalizados)
print(Barlett)
## $chisq
## [1] 1544.4
##
## $p.value
## [1] 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000015692
##
## $df
## [1] 36
Analisis factorial
library(FactoMineR)
library(factoextra)
library(kableExtra)
Rx<-cor(datos_desarrollo_normalizados)
PC<-princomp(x = datos_desarrollo_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
|
6.69
|
74.34
|
74.34
|
|
Dim.2
|
1.24
|
13.83
|
88.18
|
|
Dim.3
|
0.53
|
5.91
|
94.08
|
|
Dim.4
|
0.20
|
2.20
|
96.28
|
|
Dim.5
|
0.17
|
1.93
|
98.21
|
|
Dim.6
|
0.07
|
0.73
|
98.94
|
|
Dim.7
|
0.06
|
0.62
|
99.56
|
|
Dim.8
|
0.03
|
0.28
|
99.84
|
|
Dim.9
|
0.01
|
0.16
|
100.00
|
Grafico
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 de 2 Factores (Rotada)
library(corrplot)
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
## ALFABET 0.76 0.53 0.86 0.141 1.8
## INC_POB -0.98 0.05 0.96 0.042 1.0
## ESPVIDAF 0.62 0.76 0.96 0.036 1.9
## FERTILID -0.87 -0.40 0.92 0.079 1.4
## TASA_NAT -0.90 -0.40 0.97 0.034 1.4
## LOG_PIB 0.65 0.58 0.75 0.246 2.0
## URBANA 0.42 0.73 0.71 0.294 1.6
## MORTINF 0.66 0.71 0.94 0.059 2.0
## TASA_MOR -0.02 0.93 0.87 0.135 1.0
##
## RC1 RC2
## SS loadings 4.52 3.41
## Proportion Var 0.50 0.38
## Cumulative Var 0.50 0.88
## Proportion Explained 0.57 0.43
## Cumulative Proportion 0.57 1.00
##
## Mean item complexity = 1.6
## Test of the hypothesis that 2 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.05
##
## Fit based upon off diagonal values = 1
Correlaciones
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="orange",
number.cex = 0.75)
Factor 1 Representación: ALFABET, INC_POB, FERTILID, TASA_NAT,
LOG_PIB. Factor 2 Representación: ESPVIDAF, URBANA, MORTINF,
TASA_MOR.