Trabajo Final

Portada

Universidad de El Salvador

Facultad de Ciencias Económicas

Escuela de Economía

Economía del Desarrollo I

Prof. Jonnathan Moisés Salazar Serrano

Medición del Desarrollo bajo el enfoque ortodoxo: Pobreza, población y desarrollo económico

Integrantes:

NOMBRES	CARNET
Daniel Adalberto Hernández Martínez	HH19029
Erick Rodolfo Rojas Flores	RF21001
Jeimmy Yamileth Salazar Chávez	SC19009

GT-02

Ciclo I

Ciudad Universitaria, 08 de junio de 2025

Calculo de Indicador Sintetico

Librerias

library(wbstats)
library(dplyr)
library(tidyverse)
library(magrittr)
library(hablar)
library(ggplot2)
library(plotly)
library(TSstudio)
library(readxl)
library(readr)
library(writexl)
library(kableExtra)
library(openxlsx)
library(ineq)
library(purrr)

Obtención de datos

# Bloques geográficos (ISO 3 códigos)
bloques <- list(
  norteamerica = c("CAN", "USA", "MEX"),
  centroamerica = c("BLZ", "GTM", "HND", "NIC", "CRI", "PAN", "SLV"),
  caribe = c("HTI", "CUB", "JAM", "DOM"),
  suramerica = c("COL", "VEN", "PER", "CHL", "BOL", "ARG", "BRA")
)


asignar_bloque <- function(iso3) {
  bloque <- names(bloques)[sapply(bloques, function(x) iso3 %in% x)]
  if (length(bloque) == 0) return(NA_character_) else return(bloque)
}

# Indicadores por dimensión (capítulos 8 y 9 de Ray + ortodoxo)
D_Desigualdad_pobreza  <- map_dfr(names(bloques), function(bloque) {
  wb_data(
    indicator = c(
      "NY.GDP.PCAP.PP.KD",       # Pib_pc  
      "SI.POV.GINI",             # GINI
      "SI.POV.DDAY",             # Pobreza_extrema $1.90/día
      "SI.POV.GAPS",             # Brecha de pobreza
      "SE.ADT.LITR.ZS",          # Alfabetización adultos
      "SE.SEC.NENR",             # Matrícula secundaria
      "SP.DYN.LE00.IN",          # Esperanza de vida
      "SP.DYN.IMRT.IN"           # Mortalidad infantil
    ),
    country = bloques[[bloque]],
    start_date = 2010,
    end_date = 2023,
    lang = "es"
  ) %>%
    mutate(bloque_geografico = bloque)
})

D_Demografica <- map_dfr(names(bloques), function(bloque) {
  wb_data(
    indicator = c(
      "SP.POP.GROW",             # Tasa de crecimiento poblacional
      "SP.DYN.TFRT.IN",          # Tasa de fecundidad
      "SP.POP.0014.TO.ZS",       # % de población <15 años
      "SP.URB.TOTL.IN.ZS"        # Urbanización
    ),
    country = bloques[[bloque]],
    start_date = 2010,
    end_date = 2023,
    lang = "es"
  ) %>%
    mutate(bloque_geografico = bloque)
})



# Batería del indicador sintetico
bateria_indicador_sintetico <- D_Desigualdad_pobreza %>% 
  merge(D_Demografica, 
         by = c("country", "iso3c", "iso2c", "date"),
         all.x = TRUE)

bateria_indicador_sintetico <- bateria_indicador_sintetico %>%
  mutate(bloque_geografico = sapply(iso3c, asignar_bloque))

Normalización de los datos

# Funciones de normalizacion de Carlos Ademir Perez Alas.
norm_directa <- function(x){
  (x - min(x, na.rm = TRUE)) / (max(x, na.rm = TRUE) - min(x, na.rm = TRUE))
}   #relación positiva

norm_inversa <- function(x){
  (max(x, na.rm = TRUE) - x) / (max(x, na.rm = TRUE) - min(x, na.rm = TRUE))
}   #relación negativa


# Seleccionando las variables con correlación positiva 
bateria_indicador_sintetico %>% 
  select(    
    SE.ADT.LITR.ZS,        
    SE.SEC.NENR,           
    SP.DYN.LE00.IN,
    SP.URB.TOTL.IN.ZS
   ) %>% 
  apply(MARGIN = 2,FUN = norm_directa) %>% 
  as.data.frame() -> variables_corr_positiva_h

# Seleccionando las variables con correlación negativa 
bateria_indicador_sintetico %>% 
  select(
    SI.POV.DDAY,           
    SI.POV.GAPS,          
    SP.DYN.IMRT.IN,        
    SP.POP.GROW,           
    SP.DYN.TFRT.IN,       
    SP.POP.0014.TO.ZS, 
    NY.GDP.PCAP.PP.KD,
    SI.POV.GINI
    ) %>% 
  apply(MARGIN = 2,FUN = norm_inversa) %>% 
  as.data.frame() -> variables_corr_negativa_h



# Union de datos normalizados
bateria_normalizada <- bind_cols(
  bateria_indicador_sintetico %>% select(country, date, bloque_geografico),
  variables_corr_positiva_h,
  variables_corr_negativa_h
)

Imputación de datos

# Imputación de datos por la media
bateria_normalizada <- bateria_normalizada %>%
  mutate(across(
    .cols = -c(country, date, bloque_geografico),
    .fns = ~ ifelse(is.na(.), mean(., na.rm = TRUE), .)
  ))

Calculo de las ponderaciones

Función

### Método CRITIC Funcion creada por Carlos Ademir Perez Alas, obtenida de https://rpubs.com/ca_ademir/critic_entropia
# Método CRITIC 
ponderadores_critic <- function(matriz_datos) {
  # Desviaciones de las variables
  sigma <- apply(X = matriz_datos, MARGIN = 2, sd)
  # Correlaciones entre las variables
  rho <- cor(matriz_datos)
  # Suma de las correlaciones excedentes
  cj <- apply(X = 1 - rho, MARGIN = 2, sum)
  # Cálculos de ponderadores
  pesos_brutos <- sigma * cj
  pesos_normalizados <- prop.table(pesos_brutos)
  # Salida de resultados
  resultados <- list(pesos_brutos = pesos_brutos,
                     pesos_normalizados = pesos_normalizados)
  return(resultados) 
}

Ponderaciones Variables

#Dimensión desigualdad
w_D_desigualdad_pobreza <- bateria_normalizada %>%
  select(
    NY.GDP.PCAP.PP.KD,     # PIB per cápita 
    SI.POV.GINI,           # Gini
    SI.POV.DDAY,           # Pobreza extrema
    SI.POV.GAPS,           # Brecha de pobreza
    SP.DYN.IMRT.IN,        # Mortalidad infantil
    SE.ADT.LITR.ZS,        # Alfabetización
    SE.SEC.NENR,           # Matrícula secundaria
    SP.DYN.LE00.IN         # Esperanza de vida
  )
     
Pesos_desiguldad_pobreza<- ponderadores_critic(matriz_datos = w_D_desigualdad_pobreza)
Pesos_desiguldad_pobreza$pesos_normalizados

## NY.GDP.PCAP.PP.KD       SI.POV.GINI       SI.POV.DDAY       SI.POV.GAPS 
##        0.29681272        0.14568477        0.07413274        0.07625307 
##    SP.DYN.IMRT.IN    SE.ADT.LITR.ZS       SE.SEC.NENR    SP.DYN.LE00.IN 
##        0.10817643        0.07595234        0.12498414        0.09800378

#
w_D_Demografica <- bateria_normalizada %>%
  select(
    SP.POP.GROW,           # Crecimiento poblacional
    SP.DYN.TFRT.IN,        # Fecundidad
    SP.POP.0014.TO.ZS,     # % población <15
    SP.URB.TOTL.IN.ZS      # Urbanización
  )

Pesos_demografica <- ponderadores_critic(matriz_datos = w_D_Demografica)
Pesos_demografica$pesos_normalizados

##       SP.POP.GROW    SP.DYN.TFRT.IN SP.POP.0014.TO.ZS SP.URB.TOTL.IN.ZS 
##         0.1771001         0.2145603         0.2267402         0.3815995

Multiplicación de Ponderaciones por datos normalizados para obtener Dimensión

# Matriz pesos económicos
Pesos_D1 <- Pesos_desiguldad_pobreza$pesos_normalizados %>% as.vector.data.frame()
n1 <- nrow(w_D_desigualdad_pobreza)
W_D1 <- map2(Pesos_D1, n1, .f = rep) %>% as.data.frame()

Multi_D1 <- w_D_desigualdad_pobreza * W_D1 
Multi_D1 <- Multi_D1 %>%
  mutate(Dimension_Desigualdad_Pobreza = round(rowSums(Multi_D1), 4)) %>%
  select(Dimension_Desigualdad_Pobreza)


# Matriz pesos sociales
Pesos_D2 <- Pesos_demografica$pesos_normalizados %>% as.vector.data.frame()
n2 <- nrow(w_D_Demografica)
W_D2 <- map2(Pesos_D2, n2, .f = rep) %>% as.data.frame()

Multi_D2 <- w_D_Demografica * W_D2 
Multi_D2 <- Multi_D2 %>%
  mutate(Dimension_Demografica = round(rowSums(Multi_D2), 4)) %>%
  select(Dimension_Demografica)

#Union de dimensiones
Bateria_dimensiones <- bind_cols(
  bateria_normalizada %>% select(country, date, bloque_geografico),
  Multi_D1,
  Multi_D2
)

Ponderaciones de dimensiones

Pesos_dimensiones <- ponderadores_critic(matriz_datos = Bateria_dimensiones %>% select(starts_with("Dimension_")))
Pesos_dimensiones$pesos_normalizados

## Dimension_Desigualdad_Pobreza         Dimension_Demografica 
##                     0.1965026                     0.8034974

# Crear matriz de ponderación
Pesos_D <- Pesos_dimensiones$pesos_normalizados %>% as.vector.data.frame()
n <- nrow(Bateria_dimensiones)
W_D <- map2(Pesos_D, n, .f = rep) %>% as.data.frame()

## Multiplicación y obtención de la dimensión
Indicador_Sintetico <- Bateria_dimensiones %>%
  select(starts_with("Dimension_")) * W_D

Indicador_Sintetico <- Indicador_Sintetico %>%
  mutate(Indicador_Sintetico_Calculado = round(rowSums(Indicador_Sintetico), 4)) %>%
  select(Indicador_Sintetico_Calculado)

Exportar Tabla a Excel

Tabla_completa <- bind_cols(
  Bateria_dimensiones,
  Indicador_Sintetico
)

write_xlsx(Tabla_completa, "Tabla_Indicador_Sintetico.xlsx")