1. Ejercicio

Se pretende construir un indicador multivariado sintético sobre el Desarrollo en las Economías. Los indicadores a considerar son:

• El índice de alfabetización (alfabet) [+]
• El incremento de la población (inc_pob) [+]
• La 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) [+]
• La tasa de mortalidad (tasa_mor) [-]

Entre Corchetes aparece la correlación teórica esperada entre la variable compleja y el indicador.

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

library(dplyr)
library(kableExtra)
library(tidyr)

load("C:/Users/MINEDUCYT/Downloads/data_desarrollo.RData")

# Sin select.

# medias<-apply(X=data_desarrollo[,c(-1,-5)], MARGIN=2, mean, na.rm=TRUE)

data_desarrollo_prueba<-data_desarrollo  %>% 
  select(ALFABET, INC_POB, ESPVIDAF, MORTINF, FERTILID, TASA_NAT, LOG_PIB, URBANA, TASA_MOR) 

media<-apply(X=data_desarrollo_prueba, MARGIN=2, mean, na.rm=TRUE)

data_desarrollo_prueba<-data_desarrollo_prueba %>% 
  replace_na(
    list(ALFABET=media[1], 
         INC_POB=media[2], 
         ESPVIDAF=media[3], 
         MORTINF=media[4], 
         FERTILID=media[5], 
         TASA_NAT=media[6], 
         LOG_PIB=media[7], 
         URBANA=media[8], 
         TASA_MOR=media[9]
      
    )
  )

data_desarrollo_prueba %>%  
  head() %>% 
  kable(caption="Tabla sobre el Desarrollo en las Economías sin datos NA.",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

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

data_desarrollo_prueba %>% 
  select(ALFABET,INC_POB,ESPVIDAF, FERTILID, TASA_NAT, LOG_PIB,URBANA) %>% 
  apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->variables_corr_positiva

#Seleccionando las variables con correlación negativa 

data_desarrollo_prueba %>% 
  select(MORTINF,TASA_MOR) %>% 
  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(ALFABET,INC_POB,ESPVIDAF,MORTINF, FERTILID, TASA_NAT, LOG_PIB,URBANA,TASA_MOR)->data_desarrollo_normalizada


data_desarrollo_normalizada %>%  
  head() %>% 
  kable(caption="Tabla sobre el Desarrollo en las Economías Normalizada.",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

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

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

## [1] 0.862

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

## $chisq
## [1] 1545.1
## 
## $p.value
## [1] 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011126
## 
## $df
## [1] 36

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

Rx<-cor(data_desarrollo_normalizada)
PC<-princomp(x = data_desarrollo_normalizada,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 = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+geom_hline(yintercept = 1)

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
## MORTINF   0.66  0.71 0.94 0.062 2.0
## 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
## 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 = 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)

Las variables que quedan representadas en el factor 1, son: ALFABET, INC_POB, FERTILID, TASA_NAT, LOG_PIB.

Las variables que quedan representadas en el factor 2, son: ESPVIDAF, URBANA, MORTINF, TASA_MOR.

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

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

El factor 1 contribuye con el 57% al cálculo del indicador sintético, mientras que el factor 2 aporta un 43% al cálculo del indicador sintético.

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

Para calcular el Factor 1, se asignan pesos a las variables de la siguiente manera: X1 = ALFABET con un peso del 12%, X2 = INC_POB con un peso del 21%, X3 = ESPVIDAF con un peso del 9%, X4 = MORTINF con un peso del 10%, X5 = FERTILID con un peso del 17%, X6 = TASA_NAT con un peso del 18%, X7 = LOG_PIB con un peso del 9%, X8 = URBANA con un peso del 4%, y X9 = TASA_MOR con un peso del 0%. Estos pesos indican la contribución relativa de cada variable en la construcción del Factor 1.

Para calcular el Factor 2, se asignan pesos a las variables de la siguiente manera: X1 = ALFABET con un peso del 9%, X2 = INC_POB con un peso del 0%, X3 = ESPVIDAF con un peso del 17%, X4 = MORTINF con un peso del 15%, X5 = FERTILID con un peso del 5%, X6 = TASA_NAT con un peso del 5%, X7 = LOG_PIB con un peso del 10%, X8 = URBANA con un peso del 14%, y X9 = TASA_MOR con un peso del 26%. Estos pesos indican la contribución relativa de cada variable en la construcción del Factor 2.