Planteamiento del ejercicio

Se pretende construir un indicador multivariado sintético sobre el Desarrollo en las Economías.

Los indicadores a considerar son:

• X₁ = Índice de alfabetización (alfabet)[+]
• X₂ = Incremento de la población (inc_pob)[+]
• X₃ = Esperanza de vida femenina (espvidaf)[+]
• X₄ = Mortalidad infantil (mortinf)[-]
• X₅ = Número promedio de hijos por mujer (fertilid)[+]
• X₆ = Tasa de natalidad (tasa_nat)[+]
• X₇ = Logaritmo del PIB (log_pib)[+]
• X₈ = Población urbana (urbana)[+]
• X₉ = Tasa de mortalidad (tasa_mor)[-]

Entre corchetes aparece la correlación teórica esperada entre la variable compleja y el indicador. Todas las variables se encuentran el archivo data_desarrollo.Rdata

Desarrollar:

• Usando Análisis Factorial determine cuantos factores deberían retenerse.

• ¿Qué variables quedan representadas en cada factor?

• Determine qué pesos deben asignarse a cada factor y a las variables dentro de cada uno de ellos.

Importación de datos

load("C:/Users/johan/OneDrive/Documentos/A/MAE118/data_desarrollo.Rdata")

library(dplyr)
library(kableExtra)

# Extracción de los indicadores considerados

variables <- data_desarrollo %>% 
  mutate( pais = PAÍS,
          X1 = ALFABET,
          X2 = INC_POB,
          X3 = ESPVIDAF,
          X4 = MORTINF,
          X5 = FERTILID,
          X6 = TASA_NAT,
          X7 = LOG_PIB,
          X8 = URBANA,
          X9 = TASA_MOR) %>% 
  select(pais, X1, X2, X3, X4, X5, X6, X7, X8, X9)

# Remover valores NA

variables <- variables[complete.cases(variables),]

variables %>% head(10) %>% 
  kable(caption = "Variables consideradas para el indicador multivariado sintético sobre el desarrollo en las economías.",
        align = "c",
        digits = 2) %>%  
  kable_styling()

Normalización de datos

norm_directa<-function(x){(x-min(x))/(max(x)-min(x))}

# Selección de variables con correlación positiva 

variables %>% select(X1, X2, X3, X5, X6, X7, X8) %>%
  apply(MARGIN = 2,FUN = norm_directa) %>% 
  as.data.frame() -> variables_corr_positiva

norm_inversa<-function(x){(max(x)-x)/(max(x)-min(x))}

# Selección de variables con correlación negativa

variables %>% select(X4,X9) %>%
  apply(MARGIN = 2,FUN = norm_inversa) %>% 
  as.data.frame() -> variables_corr_negativa

variables_corr_positiva %>% 
  bind_cols(variables_corr_negativa) %>% 
  select(X1,X2,X3,X4,X5,X6,X7,X8,X9)->datos_desarrollo_normalizados

datos_desarrollo_normalizados %>% head(10) %>% 
  kable(caption = "Datos normalizados sobre el desarrollo",
        align = "c",
        digits = 4) %>%  
  kable_styling()

Matriz de correlación

library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_desarrollo_normalizados),histogram = TRUE,pch=12)

Se presenta la matriz de correlación mostrando en la diagonal principal un histograma con los kernels de densidad de probabilidad para cada una de las variables y por debajo se presenta un diagrama de dispersión donde se muestra una aproximación de la relación no lineal que pueda aparecer entre cada una de las variables.

Si no hay asteriscos , la variable no es estadísticamente significativa, mientras que una, dos y tres estrellas significan que la correspondiente variable es estadísticamente significativa para los niveles 10%, 5% y 1%, respectivamente. Para este ejercicio, las correlacciones son mayormente significativas al 1% por lo que existe una evidente correlación entre las variables propuestas en la batería de indicadores

Prueba de Kaiser–Meyer–Olkin (KMO)

library(rela)
KMO<-paf(as.matrix(datos_desarrollo_normalizados))$KMO
print(KMO)

## [1] 0.86467

KMO > 0.5 por lo que se puede considerar que el muestreo es adecuado para aplicar el análisis factorial

Prueba de Barlett

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

H₀: En Matriz de correlación muestral las variables son independientes entre ellas

H₁: En Matriz de correlación muestral las variables no son independientes entre ellas

Rechazar H₀ si:

\(\chi_{B}^2 \geq V.C.\)

Se rechaza H₀ por lo que hay evidencia de correlación entre los indicadores propuestos

Análisis 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"))

fviz_eig(PC,
         choice = "eigenvalue",
         barcolor = "red",
         barfill = "red",
         addlabels = TRUE,
         )+labs(title = "Grafico de Sedimentacion (Grafico 1)",
                subtitle = "Usando princomp, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+
  geom_hline(yintercept = 1)

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.76  0.53 0.86 0.141 1.8
## X2 -0.98  0.05 0.96 0.042 1.0
## X3  0.62  0.76 0.96 0.036 1.9
## X4  0.66  0.71 0.94 0.059 2.0
## X5 -0.87 -0.40 0.92 0.079 1.4
## X6 -0.90 -0.40 0.97 0.034 1.4
## X7  0.65  0.58 0.75 0.246 2.0
## X8  0.42  0.73 0.71 0.294 1.6
## X9 -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_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: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"))

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