Tarea 8 - Indicador Multivariado Sintético
ROJAS FLORES, ERICK RODOLFO - RF21001
Indicación: Se pretende construir un indicador multivariado sintético sobre el Desarrollo en las Economías. Los indicadores a considerar son:
- índice de alfabetización (alfabet)[+]
- incremento de la población (inc_pob)[+]
- esperanza de vida femenina (espvidaf)[+]
- la mortalidad infantil (mortinf)[-]
- el número promedio de hijos por mujer (fertilid)[+]
- la tasa de natalidad (tasa_nat)[+]
- el logaritmo del PIB (log_pib)[+]
- la población urbana (urbana)[+]
- tasa de mortalidad (tasa_mor)[-]
Entre Corchetes aparece la correlación teórica esperada entre la variable compleja y el indicador.
#Carga de datos
load("C:/Users/Erick/Desktop/RESPALDO/UES/Ciclo II - 2023/MAE118/tarea_8_RF21001/data_desarrollo.RData")
library(dplyr)
library(tidyr)
datos_desarrollo_depurado <- data_desarrollo %>%
select(ALFABET, INC_POB, ESPVIDAF, MORTINF, FERTILID, TASA_NAT, LOG_PIB, URBANA, TASA_MOR)
medias<- apply(datos_desarrollo_depurado, MARGIN = 2, mean, na.rm=TRUE)
data_desarrollo_depurado <- replace_na(datos_desarrollo_depurado, replace = list(ALFABET=medias[1],
INC_POB=medias[2],
ESPVIDAF=medias[3],
MORTINF=medias[4],
FERTILID=medias[5],
TASA_NAT=medias[6],
LOG_PIB=medias[7],
URBANA=medias[8],
TASA_MOR=medias[9]))1.1) ¿Cuántos factores deberían retenerse?
Normalización de datos
#NORMALIZACIÓN 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))}
#vARIABLES CON CORRELACIÓN POSITIVA
data_desarrollo_depurado %>%
select(ALFABET, INC_POB, ESPVIDAF, FERTILID, TASA_NAT, LOG_PIB, URBANA) %>%
apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->variables_corr_positiva
#VARIABLES CON CORRELACIÓN NEGATIVA
data_desarrollo_depurado %>%
select(MORTINF, TASA_MOR) %>%
apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()->variables_corr_negativa
#UNIÓN DE VARIABLES
variables_corr_positiva %>%
bind_cols(variables_corr_negativa) -> datos_desarrollo_normalizados
#REEMPLAZO VALORES NO EXISTENTES POR CEROS DEL DF DE DATOS DESARROLLADOS PARA PODER CONTINUAR DESARROLLANDO EL EJERCICIO
datos_desarrollo_normalizados<-replace(datos_desarrollo_normalizados, is.na(datos_desarrollo_normalizados),0)
head(datos_desarrollo_normalizados)#Matriz de correlación
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_desarrollo_normalizados),histogram = TRUE,pch=12)
Pruebas de correlación
#KMO
install.packages("C:/Users/Erick/AppData/Local/R/win-library/4.3/rela_4.0.tar.gz", repos = NULL, type = "source")
library(rela)
KMO<-paf(as.matrix(datos_desarrollo_normalizados))$KMO
print(KMO)## [1] 0.862Destacando que el valor mínimo del índice de KMO para considerar aceptable el análisis factorial es de 0.5, podemos observar que el resultado de la prueba es de 0.862 cumpliendo así con el requisito
#Prueba de Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(datos_desarrollo_normalizados)
print(Barlett)## $chisq
## [1] 1545.1
##
## $p.value
## [1] 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011126
##
## $df
## [1] 36Considerando que la H0 nos dice que nuestra matriz de correlación muestral se distribuye como una matriz identidad a nivel poblacional, es decir, que las variables son independientes entre ellas.
Por lo tanto, utilizando el Pvalue para la prueba de decisión y concluimos que se rechaza H0, por lo tanto hay evidencia de correlación poblacional entre la batería de indicadores propuestos
Análisis Factorial
library(FactoMineR)
library(factoextra)
library(kableExtra)
Rx<-cor(datos_desarrollo_normalizados)
PC<-princomp(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"))| eigenvalue | variance.percent | cumulative.variance.percent | |
|---|---|---|---|
| Dim.1 | 6.62 | 73.53 | 73.53 |
| Dim.2 | 1.25 | 13.88 | 87.41 |
| Dim.3 | 0.54 | 5.95 | 93.36 |
| Dim.4 | 0.25 | 2.77 | 96.12 |
| Dim.5 | 0.18 | 1.97 | 98.10 |
| Dim.6 | 0.07 | 0.79 | 98.89 |
| Dim.7 | 0.06 | 0.63 | 99.52 |
| Dim.8 | 0.03 | 0.28 | 99.80 |
| Dim.9 | 0.02 | 0.20 | 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)
Respuesta: Según el criterio de raíz latente, el criterio de los 3/4 y el criterio de elbow, tenemos una convergencia en todos para retener únicamente 2 factores, los cuales son representativos de la batería de indicadores.
1.2) ¿Qué variables quedan representadas en cada factor?
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
## ALFABET 0.75 0.54 0.85 0.148 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.39 0.91 0.087 1.4
## TASA_NAT -0.90 -0.39 0.96 0.036 1.4
## LOG_PIB 0.64 0.58 0.74 0.256 2.0
## URBANA 0.44 0.69 0.66 0.336 1.7
## MORTINF 0.66 0.71 0.94 0.062 2.0
## TASA_MOR -0.04 0.93 0.87 0.130 1.0
##
## RC1 RC2
## SS loadings 4.50 3.36
## Proportion Var 0.50 0.37
## Cumulative Var 0.50 0.87
## 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 = 1correlaciones_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)
Respuesta: Podemos observar en el gráfico anterior que las variables quedan representadas de la siguiente forma:
índice de alfabetización (alfabet): Factor 1.
incremento de la población (inc_pob): Factor 1.
esperanza de vida femenina (espvidaf): Factor 2.
el número promedio de hijos por mujer (fertilid): Factor 1
la tasa de natalidad (tasa_nat): Factor 1.
el logaritmo del PIB (log_pib): Factor 1.
la población urbana (urbana): Factor 2.
la mortalidad infantil (mortinf): Factor 2.
tasa de mortalidad (tasa_mor): Factor 2
1.3) ¿Qué pesos deben asignarse a cada factor y variables?
library(kableExtra)
cargas<-rotacion$loadings[1:9,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"))| Dim.1 | Dim.2 |
|---|---|
| 0.57 | 0.43 |
Respuesta: Los ponderadores o pesos que deben asignarse a cada factor (2) son los siguientes:
Factor 1: 0.51
Factor 2: 0,43
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"))| Dim.1 | Dim.2 | |
|---|---|---|
| ALFABET | 0.12 | 0.09 |
| INC_POB | 0.21 | 0.00 |
| ESPVIDAF | 0.09 | 0.17 |
| FERTILID | 0.17 | 0.05 |
| TASA_NAT | 0.18 | 0.05 |
| LOG_PIB | 0.09 | 0.10 |
| URBANA | 0.04 | 0.14 |
| MORTINF | 0.10 | 0.15 |
| TASA_MOR | 0.00 | 0.26 |
Respuesta: Los ponderadores o pesos que deben asignarse a cada variable (9) dentro de cada uno de los factores/variables latentes (2) son los siguientes:
índice de alfabetización (alfabet): 0.12 para el factor 1 y 0.09 para el factor 2.
incremento de la población (inc_pob): 0.21 para el factor 1 y 0.00 para el factor 2.
esperanza de vida femenina (espvidaf): 0.09 para el factor 1 y 0.17 para el factor 2.
el número promedio de hijos por mujer (fertilid): 0.17 para el factor 1 y 0.05 para el factor 2.
la tasa de natalidad (tasa_nat): 0.18 para el factor 1 y 0.05 para el factor 2.
el logaritmo del PIB (log_pib): 0.09 para el factor 1 y 0.10 para el factor 2.
la población urbana (urbana): 0.04 para el factor 1 y 0.14 para el factor 2.
la mortalidad infantil (mortinf): 0.10 para el factor 1 y 0.15 para el factor 2.
tasa de mortalidad (tasa_mor): 0.00 para el factor 1 y 0.26 para el factor 2.