Introducción

En este informe desarrollamos un análisis predictivo de la esperanza de vida en países de Sudamérica a partir de indicadores socioeconómicos, utilizando datos del Banco Mundial correspondientes al año 2015. El objetivo es explorar qué factores estructurales permiten distinguir a los países con mayor y menor esperanza de vida, apoyados en modelos de clasificación supervisada.

Metodología y preparación de datos

Se seleccionó el año 2015 por ser el más reciente con datos completos y comparables para la región. El dataset resultante presenta una fila por país y al menos 10 variables socioeconómicas (PIB per cápita, alfabetización, urbanización, gastos en salud, tasa de fertilidad, mortalidad infantil, población total, acceso a agua, desempleo y gasto en educación).

La variable objetivo es la esperanza de vida al nacer (años), transformada en binaria según la mediana regional de Sudamérica en 2015:

1 (“alta”) si el país tiene esperanza de vida igual o superior a la mediana, 0 (“baja”) si es inferior. La dicotomización se justifica para identificar factores asociados a desempeños por encima/más allá del promedio regional.

Se imputaron los valores faltantes con la mediana de cada variable numérica y se eliminaron las variables objetivo originales (esperanza de vida) y el nombre del país antes de modelar.

El dataset se dividió en entrenamiento (80%) y prueba (20%) utilizando muestreo estratificado para asegurar la representatividad de ambas clases en ambos conjuntos.

Instala y carga todos los paquetes necesarios

paquetes <- c("readxl", "tidyr", "dplyr", "caret", "class", "rpart", "rpart.plot")
instalar <- paquetes[!sapply(paquetes, require, character.only = TRUE)]
## Loading required package: readxl
## Loading required package: tidyr
## Loading required package: dplyr
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
## Loading required package: caret
## Loading required package: ggplot2
## Loading required package: lattice
## Loading required package: class
## Loading required package: rpart
## Loading required package: rpart.plot
if (length(instalar) > 0) install.packages(instalar)
lapply(paquetes, require, character.only = TRUE)
## [[1]]
## [1] TRUE
## 
## [[2]]
## [1] TRUE
## 
## [[3]]
## [1] TRUE
## 
## [[4]]
## [1] TRUE
## 
## [[5]]
## [1] TRUE
## 
## [[6]]
## [1] TRUE
## 
## [[7]]
## [1] TRUE

Transformación de datos

Dado que los datos están segregados por país y por año, se pivotan para disponerlos de manera que sea útil para la creación de un modelo predictivo. Se utilizará la regla de binarización establecida anteriormente.

df <- read_excel("./P_Data_Extract_From_World_Development_Indicators (5).xlsx", sheet = "Data")
df_wide <- df %>%
  select(`Country Name`, `Series Name`, `2015 [YR2015]`) %>%
  filter(`2015 [YR2015]` != "..") %>%
  pivot_wider(names_from = `Series Name`, values_from = `2015 [YR2015]`)

Conversión a numérico de las columnas socioeconómicas

df_ml <- df_wide %>%
  mutate(across(-`Country Name`, as.numeric))

Binarización

mediana_sv <- median(df_ml$`Life expectancy at birth, total (years)`, na.rm = TRUE)
df_ml <- df_ml %>%
  mutate(LifeExp_Bin = ifelse(`Life expectancy at birth, total (years)` >= mediana_sv, 1, 0))

df_ml$LifeExp_Bin <- as.factor(df_ml$LifeExp_Bin)  # Factor para clasificación

Imputar los NA con la mediana por variable (excepto Country Name)

vars_num <- setdiff(names(df_ml), c("Country Name"))
for (v in vars_num) {
  if(is.numeric(df_ml[[v]])) {
    df_ml[[v]][is.na(df_ml[[v]])] <- median(df_ml[[v]], na.rm = TRUE)
  }
}

Selección de variables numéricas (excepto la variable objetivo)

vars <- c(
   "Country Name",
  "GDP per capita (current US$)",
  "Urban population (% of total population)",
  "Current health expenditure (% of GDP)",
  "Fertility rate, total (births per woman)",
  "Mortality rate, infant (per 1,000 live births)",
  "Population, total",                     
  "People using at least basic drinking water services (% of population)",
  "Unemployment, total (% of total labor force) (modeled ILO estimate)",
  "Government expenditure on education, total (% of GDP)",
  "Life expectancy at birth, total (years)",
  "Literacy rate, adult total (% of people ages 15 and above)" 
)
df_ml <- df_ml %>% select(`Country Name`, all_of(vars))

Resumen y visualización estadística

Con el fin de evaluar los principales indicadores estadísticos, así como la distribución de los datos, se realizarán histogramas y diagramas de caja y bigote.

Resumen estadístico

if (!"LifeExp_Bin" %in% colnames(df_ml)) {
  mediana_sv <- median(df_ml$`Life expectancy at birth, total (years)`, na.rm = TRUE)
  df_ml <- df_ml %>%
    mutate(LifeExp_Bin = ifelse(`Life expectancy at birth, total (years)` >= mediana_sv, 1, 0))
}
df_ml %>%
  group_by(LifeExp_Bin) %>%
  summarise(across(where(is.numeric), list(media=mean, sd=sd)))

Box-plots

vars_graficar <- setdiff(
  names(df_ml)[sapply(df_ml, is.numeric)],
  c("LifeExp_Bin", "Life.expectancy.at.birth..total..years.")  # Usa aquí el nombre que corresponda exactamente en tu objeto
)
for (var in vars_graficar) {
  boxplot(df_ml[[var]] ~ df_ml$LifeExp_Bin,
          main = paste("Boxplot de", var, "por grupo de esperanza de vida"),
          xlab = "Esperanza de vida binaria (0=baja, 1=alta)",
          ylab = var)
}

Histogramas

Con el fin de obtener una visualización precisa de la distribución de los datos, se separan los histogramas para observar la distribución de los datos por clase. Esto es, se generarán para cada variable predictora dos histogramas, uno mostrando la distribución para la esperanza de vida baja y otro para la esperanza de vida alta.

for (var in vars_graficar) {
  hist(df_ml[[var]][df_ml$LifeExp_Bin == 0],
       main = paste("Histograma de", var, "- Esperanza de vida baja"),
       xlab = var, col = "red", breaks = 10)
  hist(df_ml[[var]][df_ml$LifeExp_Bin == 1],
       main = paste("Histograma de", var, "- Esperanza de vida alta"),
       xlab = var, col = "blue", breaks = 10)
}

# Preparación Se imputarán los datos faltantes con la mediana, medida de tendencia central que no es sensible a datos atípicos. Adicionalmente se realizará una división 80/20 estratificada, con el fin de tener un dataset de pruebas ocn clases suficientes para hacer una evaluación efectiva.

Adicionalmente, se eliminarán las columnas no predictoras, se separarán las variables y se harán correcciones necesarias para evitar errores.

Particionado estratificado en train/test (80/20)

set.seed(3)
splitIndex <- createDataPartition(df_ml$LifeExp_Bin, p = 0.8, list = FALSE)
train <- df_ml[splitIndex, ]
test  <- df_ml[-splitIndex, ]

Eliminar columnas no predictoras (esperanza de vida original y country) y ajustar nombres

train <- train %>% select(-`Life expectancy at birth, total (years)`, -`Country Name`)
test  <- test %>% select(-`Life expectancy at birth, total (years)`, -`Country Name`)

Separar variables predictoras y target para ambos sets

train_x <- train %>% select(-LifeExp_Bin)
train_y <- train$LifeExp_Bin
test_x <- test %>% select(-LifeExp_Bin)
test_y <- test$LifeExp_Bin

colnames(train_x) <- make.names(colnames(train_x))
colnames(test_x)  <- make.names(colnames(test_x))

Estandarización (recomendada para KNN)

preProc <- preProcess(train_x, method = c("center", "scale"))
train_x_stand <- predict(preProc, train_x)
test_x_stand  <- predict(preProc, test_x)

Entrenamiento

Se desarrollarán y compararán los resultados de dos modelos diferentes: Uno entrenado mediante k-nearest-neightbors (kNN) y otro mediante árboles de decisión.

kNN

set.seed(3)
knn_pred <- knn(train = train_x_stand, test = test_x_stand, cl = train_y, k = 3)
# Ajustar niveles para matriz de confusión
niveles <- sort(unique(c(as.character(test_y), as.character(knn_pred))))
test_factor_knn <- factor(test_y, levels = niveles)
knn_pred_factor <- factor(knn_pred, levels = niveles)
confusionMatrix(knn_pred_factor, test_factor_knn)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 0 1
##          0 0 0
##          1 1 1
##                                           
##                Accuracy : 0.5             
##                  95% CI : (0.0126, 0.9874)
##     No Information Rate : 0.5             
##     P-Value [Acc > NIR] : 0.75            
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : 1.00            
##                                           
##             Sensitivity : 0.0             
##             Specificity : 1.0             
##          Pos Pred Value : NaN             
##          Neg Pred Value : 0.5             
##              Prevalence : 0.5             
##          Detection Rate : 0.0             
##    Detection Prevalence : 0.0             
##       Balanced Accuracy : 0.5             
##                                           
##        'Positive' Class : 0               
##

Árbol de Decisión

set.seed(3)
arbol <- rpart(
  LifeExp_Bin ~ .,
  data = data.frame(train_x, LifeExp_Bin = train_y),
  method = "class",
  control = rpart.control(
    maxdepth = 5,
    minsplit = 3,
    minbucket = 3,
    cp = 0.01
  )
)
arbol_pred <- predict(arbol, newdata = test_x, type = "class")
# Ajustar niveles para matriz de confusión del árbol
niveles_tree <- sort(unique(c(as.character(test_y), as.character(arbol_pred))))
test_factor_arbol <- factor(test_y, levels = niveles_tree)
arbol_pred_factor <- factor(arbol_pred, levels = niveles_tree)
confusionMatrix(arbol_pred_factor, test_factor_arbol)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 0 1
##          0 1 1
##          1 0 0
##                                           
##                Accuracy : 0.5             
##                  95% CI : (0.0126, 0.9874)
##     No Information Rate : 0.5             
##     P-Value [Acc > NIR] : 0.75            
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : 1.00            
##                                           
##             Sensitivity : 1.0             
##             Specificity : 0.0             
##          Pos Pred Value : 0.5             
##          Neg Pred Value : NaN             
##              Prevalence : 0.5             
##          Detection Rate : 0.5             
##    Detection Prevalence : 1.0             
##       Balanced Accuracy : 0.5             
##                                           
##        'Positive' Class : 0               
## 
rpart.plot(arbol)

## Comparación

Si bien ambos modelos tienen la misma precisión (0.5), el modelo de árbol tiene una sensibilidad de 1, lo que podría indicar que es mejor. No obstante, dada la falta de datos de entrenamiento, los resultados hay que interpretarlos cuidadosamente y dentro de su contexto.

Conclusión

Los resultados obtenidos con base en la evidencia empírica, y de acuerdo con el modelo de árbol de decisión, es que el factor principal de un país para que su expectativa de vida sea alta es un PIB elevado. Valga la redundancia, este análisis está sujeto a la baja disponibilidad de datos y es posible que futuras investigaciones con un mayor volúmen de datos evidencie resultados diferentes a los expuestos.

Bibliografía