Desarollo

Indicacion

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)[+]
• Y la tasa de mortalidad (tasa_mor)[-].
• Procedemos a la Carga de datos

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

Desarrollo 1.1)

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

Comenzamos con la carga de datos

library(dplyr)
load("C:/Users/pc/Downloads/Tarea_8_LP16016_MAE/data_desarrollo.RData")

Normalizacion de datos

library(dplyr)
library(tidyr)
norm_directa<-function(x){(x-min(x))/(max(x)-min(x))}
norm_inversa<-function(x){(max(x)-x)/(max(x)-min(x))}

## Eliminando valores nulos

data_desarrollo%>% 
  replace_na(list(ALFABET=0,INC_POB=0,ESPVIDAF=0,FERTILID=0,
                  TASA_NAT=0,LOG_PIB=0,URBANA=0,MORTINF=0,
                  TASA_MOR=0))->data_parcial_2 

## Seleccionando variables con correlación positiva con desarrollo de economias 
data_parcial_2%>% 
  dplyr::select(ALFABET,INC_POB,ESPVIDAF,
                FERTILID,TASA_NAT,LOG_PIB,URBANA) %>% 
  apply(MARGIN = 2,FUN = norm_directa) %>% 
  as.data.frame()->var_corr_positiva

## Seleccionando variables con correlación negativa con desarrollo de economias
data_parcial_2 %>% 
  dplyr::select(MORTINF,TASA_MOR) %>% 
  apply(MARGIN = 2,FUN = norm_inversa) %>% 
  as.data.frame()->var_corr_negativa 

## Juntando y reordenando las variables

var_corr_positiva %>% 
  bind_cols(var_corr_negativa) %>% 
  dplyr::select(ALFABET,INC_POB,
                ESPVIDAF,FERTILID,TASA_NAT,
                LOG_PIB,URBANA,MORTINF,TASA_MOR)->data_p2_normalizados
head(data_p2_normalizados)

##   ALFABET   INC_POB   ESPVIDAF  FERTILID   TASA_NAT    LOG_PIB URBANA   MORTINF
## 1    0.98 0.3068592 0.82051282 0.3418803 0.30232558 0.60885423   0.54 0.8109756
## 2    0.29 0.5595668 0.02564103 0.8424908 1.00000000 0.09867408   0.18 0.0000000
## 3    0.99 0.1191336 0.92307692 0.1794872 0.02325581 0.94458420   0.85 0.9847561
## 4    0.62 0.6317690 0.69230769 0.8144078 0.65116279 0.76022519   0.77 0.7073171
## 5    0.95 0.2888087 0.82051282 0.3418803 0.23255814 0.63309802   0.86 0.8682927
## 6    0.98 0.3068592 0.82051282 0.3894994 0.30232558 0.70597624   0.68 0.8597561
##     TASA_MOR
## 1 0.70833333
## 2 0.08333333
## 3 0.54166667
## 4 0.75000000
## 5 0.62500000
## 6 0.75000000

Matriz de correlacion Rx

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

Pruebas KMO y Barlett

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

## [1] 0.85275

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

## $chisq
## [1] 1478.1
## 
## $p.value
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000017846
## 
## $df
## [1] 36

Como el KMO > 0.5 y el pvalue < 0.05, se tiene que puede procederse al análisis factorial porque existe multicolinealidad en los valores de la matriz de información

analisis factorial

library(FactoMineR)
library(factoextra)
library(kableExtra)
Rx<-cor(data_p2_normalizados)
PC<-princomp(x = data_p2_normalizados,cor = TRUE,fix_sign = FALSE)
variables_pca<-get_pca_var(PC)
factoextra::get_eig(PC) %>% kable(caption="Resumen PCA",
        align = "c",
        digits = 2) %>% 
  kable_material_dark(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("hover"))

Gráfico de sedimentación

fviz_eig(PC,
         choice = "eigenvalue",
         barcolor = "pink",
         barfill = "blue",
         addlabels = TRUE, 
       )+labs(title = "Gráfico de Sedimentación",
              subtitle = "Usando princomp, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+geom_hline(yintercept = 1)

Basado en el criterio de raíz latente (que se verifica en el gréfico de sedimentación), en el criterio del autovalor mayor que 1, en el criterio que están por encima del turning point y en que ambos explican más del 70% de la varianza acumulada, se extraen los primeros 2 componentes.

Desarrollo 1.2)

1.2) ¿Qué variables quedan representadas en cada factor?

library(corrplot)
#Modelo de 2 Factores (Rotada)
numero_de_factores<-2
modelo_2_factores<-principal(r = Rx,
                             nfactors = numero_de_factores,
                             covar = FALSE,
                             rotate = "varimax")
print(modelo_2_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.70  0.51 0.74 0.260 1.8
## INC_POB  -0.98  0.04 0.96 0.041 1.0
## ESPVIDAF  0.62  0.76 0.95 0.048 1.9
## FERTILID -0.87 -0.40 0.91 0.091 1.4
## TASA_NAT -0.90 -0.40 0.96 0.036 1.4
## LOG_PIB   0.62  0.59 0.73 0.270 2.0
## URBANA    0.39  0.71 0.66 0.342 1.6
## MORTINF   0.65  0.71 0.92 0.075 2.0
## TASA_MOR -0.03  0.92 0.85 0.148 1.0
## 
##                        RC1  RC2
## SS loadings           4.35 3.34
## Proportion Var        0.48 0.37
## Cumulative Var        0.48 0.85
## 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 = 0.99

#Gráfico de aglomeración de las variables en los factores

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 = "circle",
         addCoef.col="black",
         number.cex = 0.75)

• En el factor 1 quedan representadas ALFABET, INC_POB, FERTILID, TASA_NAT Y LOG_PIB
• En el factor 2 quedan representadas ESPVIDAF, URBANA, MORTINF Y TASA_MOR

Desarrollo 1.3

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

# Cargas de cada dimensión
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_dark(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

# Contribuciones

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_dark(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))