load("C:/Users/crist/Downloads/data_desarrollo.Rdata") 
head(data_desarrollo)

library(dplyr)
norm_directa<-function(x){x - min(x, na.rm = TRUE)/(max(x, na.rm = TRUE) - min(x, na.rm = TRUE))}
norm_inversa<-function(x){(max(x, na.rm = TRUE) - x)/(max(x, na.rm = TRUE) - min(x, na.rm = TRUE))}
# Variables con correlación positiva 
data_desarrollo %>% 
  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 %>% 
  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  )->datos_desarollo_normalizados
head(datos_desarollo_normalizados)

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

# El gráfico nos muestra que existe una fuerte correlación entre cada una de las variables en estudio.

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

# KMO es cercano a 1, por lo tanto podemos tener confianza en que los datos son adecuados para el análisis factorial.

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

# Se rechaza la H0, es decir, los datos no son independientes entre sí y por tanto es necesario el análisis factorial.

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

datos_desarollo_sin_na <- datos_desarollo_normalizados[complete.cases(datos_desarollo_normalizados), ]

Rx<-cor(datos_desarollo_sin_na)
PC<-princomp(x = datos_desarollo_sin_na,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"))

# El Porcentaje de Varianza Explicada. Depende del interés, retiene componentes que expliquen al menos tres cuartas partes (75%) de la varianza total, En este caso, al considerar las dos primeras dimensiones, logramos explicar un 88.18% de la varianza, cumpliendo así con este criterio.

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

# El método del "codo" en el gráfico indica que deberíamos conservar la cantidad de componentes que se encuentran antes o en el punto de inflexión en la curva. En este caso este criterio nos sugiere retener las 2 primeras dimensiones, ya qie representan el punto de quiebre en el grafico.

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

# Existe una solución bastante representativa de la bateria de datos originales, lo que nos indica que se pierde muy poca información en el proceso.

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="yellow",
         number.cex = 0.75)

# Se extraen dos variables latentes en el análisis factorial. En la dimensión 1, se retienen las variables: alfabetismo, incidencia de pobreza, fertilidad, tasa de natalidad, y el logaritmo del PIB. En la dimensión 2, se retienen las variables: esperanza de vida, tasa de mortalidad infantil, población urbana y tasa de mortalidad general.

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

# La Dimensión 1 explica aproximadamente el 57% de la varianza total de los datos. La Dimensión 2 explica aproximadamente el 43% de la varianza total de los datos.

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