El acceso a la salud y a una nutrición adecuada constituye una necesidad universal; sin embargo, persisten profundas brechas globales entre quienes disfrutan de estos derechos desde el nacimiento y quienes enfrentan barreras para alcanzarlos. ¿Cómo saber si nuestro pais puede cubrir esas necesidades?, a partir de esta pregunta surge una interrogante central: ¿qué variables determinan si un país es eficiente o ineficiente en la gestión de su salud y nutrición? El presente trabajo analiza los indicadores sanitarios, nutricionales y demográficos de 193 países con el fin de evaluar y categorizar su nivel de eficiencia, identificando los factores que explican sus diferencias a escala global, utilizando el algoritmo de aprendizaje no supervisado, el cual explora la estructura interna del conjunto de datos para descubrir patrones, asociaciones y agrupaciones naturales que no son evidentes a simple vista.

El análisis del desempeño sanitario y demográfico a nivel global representa un desafío fundamental para la gestión pública y la economía de la salud. El Banco Mundial proporciona 15 indicadores reconocidos internacionalmente que miden dimensiones distintas del bienestar humano: infraestructura y capacidad médica (médicos y camas de hospital por cada 1.000 habitantes), estado de salud y longevidad (esperanza de vida al nacer, tasa de mortalidad infantil y materna), inversión y financiamiento sanitario (gasto corriente en salud per cápita, gasto de bolsillo), medicina preventiva (cobertura de inmunización DPT y sarampión), y factores nutricionales y demográficos (prevalencia de desnutrición, sobrepeso en adultos, tasa de natalidad y fertilidad) (World Bank, 2022).

Analizar estas 15 variables de forma independiente genera ruido analítico debido a las altas correlaciones intervariables; analizarlas de manera integrada mediante técnicas de aprendizaje no supervisado como el Análisis de Componentes Principales (ACP) y el método de clusterización jerárquica de Ward permite reducir la dimensionalidad de los datos y revelar patrones latentes de desarrollo internacional. Estos hallazgos proporcionan evidencia empírica esencial para orientar la formulación de políticas públicas, la priorización de inversión en infraestructura de salud y el diseño de estrategias de cooperación internacional.

2 Metodología

El presente estudio adoptó un enfoque de aprendizaje no supervisado orientado a la caracterización y segmentación de países a partir de sus indicadores multidimensionales de salud, nutrición y estructura demográfica, implementado mediante dos técnicas analíticas complementarias: el Análisis de Componentes Principales (ACP) para la reducción de dimensionalidad y el método jerárquico de Ward para la clusterización.

2.1 Selección de base de datos

Se utilizó la base de datos proveniente del repositorio internacional Health Nutrition and Population Statistics que se encuentra en la plataforma oficial DataBank del Banco Mundial (World Bank DataBank). La elección del año 2022 permite capturar la realidad y capacidad de recuperación de los sistemas de salud globales inmediatamente después del periodo crítico de la pandemia por COVID-19. En este contexto, 2022 funciona como un “revelador” excepcional de vulnerabilidades y fortalezas estructurales subyacentes de los países. En el ámbito sanitario, este corte transversal permite capturar con precisión cómo se distribuyen la inversión en salud, la infraestructura médica y la longevidad en la etapa posterior a la emergencia sanitaria global.

2.2 Descripción de las variables

A partir de datos correspondientes al año 2022, el estudio evalúa a 193 países mediante 15 variables cuantitativas categorizadas en cuatro dimensiones del bienestar humano: longevidad y salud materna/infantil, infraestructura sanitaria, medicina preventiva con factores de riesgo, y dinámica demográfica.

2.2.1 Dimension de longevidad y salud materna/infantil

Esperanza de vida al nacer, mortalidad en menores de 5 años y razón de mortalidad materna. Esta dimensión mide la efectividad real del entorno socio-sanitario y la capacidad de un país para preservar la vida humana en las etapas de mayor vulnerabilidad biológica.

library(dplyr)
library(gt)

# 1. definir la variable de salud
variables_salud <- data.frame(
  Variable = c(
    "Esperanza de vida al nacer (años)",
    "Mortalidad en menores de 5 años (‰)",
    "Mortalidad materna (por 100k nacidos)"
  ),
  Descripción = c(
    "Número promedio de años que viviría un recién nacido bajo los patrones de mortalidad actuales del país.",
    "Probabilidad por cada 1.000 nacidos vivos de morir antes de alcanzar los 5 años de edad.",
    "Número de muertes de mujeres por causas asociadas al embarazo o parto por cada 100.000 nacidos vivos."
  ),
  Interpretación = c(
    ">78 años: alta longevidad\n68-78 años: longevidad intermedia\n<68 años: baja longevidad",
    "<10‰: baja mortalidad (sistema sólido)\n10-40‰: nivel intermedio\n>40‰: alta mortalidad infantil",
    "<20: cobertura obstétrica alta\n20-100: nivel moderado\n>100: alta mortalidad materna"
  )
)

# 2. Renderizar la Tabla 1 con el paquete gt
tabla_1 <- variables_salud %>%
  gt() %>%
  tab_header(
    title = md("**Tabla 1: Variables de Longevidad y Salud Infantil/Materna y su Interpretación**")
  ) %>%
  cols_label(
    Variable = md("**Variable**"),
    Descripción = md("**Descripción**"),
    Interpretación = md("**Interpretación**")
  ) %>%
  cols_align(
    align = "left",
    columns = everything()
  ) %>%
  tab_style(
    style = list(
      cell_text(weight = "bold", size = "medium", color = "white"),
      cell_fill(color = "#FF0000")
    ),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = cell_borders(
      sides = c("top", "bottom"),
      color = "#FF0000",
      weight = px(2)
    ),
    locations = list(
      cells_column_labels(),
      cells_body()
    )
  ) %>%
  tab_style(
    style = cell_borders(
      sides = "right",
      color = "#FF0000",
      weight = px(1)
    ),
    locations = cells_body(columns = c(Variable, Descripción))
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "white"),
      cell_text(color = "#333333")
    ),
    locations = cells_body()
  ) %>%
  tab_style(
    style = cell_text(weight = "bold", color = "#FF0000"),
    locations = cells_body(columns = Variable)
  ) %>%
  tab_style(
    style = cell_text(size = "small", color = "#333333"),
    locations = cells_body(columns = c(Descripción, Interpretación))
  ) %>%
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "#FF0000", size = "large")
    ),
    locations = cells_title(groups = "title")
  ) %>%
  tab_style(
    style = list(
      cell_text(color = "#333333", size = "medium")
    ),
    locations = cells_title(groups = "subtitle")
  ) %>%
  tab_options(
    table.font.names = "Times New Roman",
    table.width = px(820),
    table.border.top.style = "none",
    table.border.bottom.style = "none",
    column_labels.border.top.style = "solid",
    column_labels.border.top.color = "#FF0000",
    column_labels.border.top.width = px(4),
    column_labels.border.bottom.style = "solid",
    column_labels.border.bottom.width = px(4),
    column_labels.border.bottom.color = "#FF0000",
    table_body.border.bottom.style = "none",
    table_body.border.top.style = "none",
    table_body.hlines.style = "solid",
    table_body.hlines.color = "#FF0000",
    table_body.hlines.width = px(3),
    table.background.color = "white",
    data_row.padding = px(18),
    heading.title.font.size = 10,
    heading.subtitle.font.size = 10,
    heading.padding = px(18),
    heading.border.bottom.style = "solid",
    heading.border.bottom.width = px(4),
    heading.border.bottom.color = "#FF0000",
    footnotes.padding = px(7),
    footnotes.font.size = 14,
    source_notes.font.size = 14,
    source_notes.padding = px(10)
  ) %>%
  tab_source_note(
    source_note = md("**Fuentes:** Elaboración propia con base en Banco Mundial (2022), OMS y UN IGME.")
  ) %>%
  opt_css(
    css = "
    .gt_table {
      border: none !important;
      border-collapse: separate !important;
      border-spacing: 0 !important;
    }
    
    /* Borde superior y esquinas superiores redondeadas en los encabezados */
    .gt_column_heading {
      border-top: 2px solid #ff0000 !important;
    }
    .gt_column_heading:first-child {
      border-left: 2px solid #ff0000 !important;
      border-top-left-radius: 12px !important;
    }
    .gt_column_heading:last-child {
      border-right: 2px solid #ff0000 !important;
      border-top-right-radius: 12px !important;
    }
   
    /* Bordes laterales externos en las filas del cuerpo */
    .gt_table_body tr td:first-child {
      border-left: 2px solid #ff0000 !important;
    }
    .gt_table_body tr td:last-child {
      border-right: 2px solid #ff0000 !important;
    }
    
    /* Borde inferior y esquinas inferiores redondeadas en la última fila */
    .gt_table_body tr:last-child td {
      border-bottom: 2px solid #ff0000 !important;
    }
    .gt_table_body tr:last-child td:first-child {
      border-bottom-left-radius: 12px !important;
    }
    .gt_table_body tr:last-child td:last-child {
      border-bottom-right-radius: 12px !important;
    }
    "

  )

# 3. Imprimir tabla
tabla_1

Variable	Descripción	Interpretación
Tabla 1: Variables de Longevidad y Salud Infantil/Materna y su Interpretación
Esperanza de vida al nacer (años)	Número promedio de años que viviría un recién nacido bajo los patrones de mortalidad actuales del país.	>78 años: alta longevidad 68-78 años: longevidad intermedia <68 años: baja longevidad
Mortalidad en menores de 5 años (‰)	Probabilidad por cada 1.000 nacidos vivos de morir antes de alcanzar los 5 años de edad.	<10‰: baja mortalidad (sistema sólido) 10-40‰: nivel intermedio >40‰: alta mortalidad infantil
Mortalidad materna (por 100k nacidos)	Número de muertes de mujeres por causas asociadas al embarazo o parto por cada 100.000 nacidos vivos.	<20: cobertura obstétrica alta 20-100: nivel moderado >100: alta mortalidad materna
Fuentes: Elaboración propia con base en Banco Mundial (2022), OMS y UN IGME.

Conclusión. La Tabla 1 reúne los tres indicadores que miden el resultado final del sistema de salud: cuánto vive la población y cuántas personas mueren en las etapas de mayor vulnerabilidad.

Cómo se distribuyen los países: al aplicar estos rangos a nuestra base (Tabla 8), 94 países (49 %) tienen longevidad intermedia, 55 (28 %) tienen baja longevidad y solo 44 (23 %) superan los 78 años.
El indicador más crítico: la mortalidad materna es la que deja más países en el nivel de alerta: 69 países (36 %) superan las 100 muertes por cada 100.000 nacidos vivos, frente a 44 países (23 %) con mortalidad infantil alta.
Qué esperamos en el modelo: las tres variables describen el mismo fenómeno desde ángulos distintos, por lo que deberían moverse juntas y pesar en el mismo componente del ACP.

2.2.2 Dimension de infraestructura y recursos del sistema de salud

La infraestructura y los recursos del sistema sanitario constituyen la estructura física, humana y tecnológica que determina la capacidad operativa real de una nación para atender las necesidades asistenciales de su población.

library(dplyr)
library(gt)

# 1. Definir las 5 variables de Infraestructura y Recursos del Sistema de Salud
variables_infraestructura <- data.frame(
  Variable = c(
    "Gasto corriente en salud pc (US$)",
    "Gasto de bolsillo (% gasto salud)",
    "Médicos (por 1.000 personas)",
    "Enfermería y partería (por 1.000 p.)",
    "Camas de hospital (por 1.000 p.)"
  ),
  Descripción = c(
    "Gasto público y privado total en bienes y servicios de salud consumidos por habitante en dólares corrientes.",
    "Porcentaje del gasto total en salud pagado directamente del bolsillo de los hogares.",
    "Número de médicos generales y especialistas con ejercicio activo disponible por cada 1.000 habitantes.",
    "Número de enfermeros y parteros calificados en servicio activo por cada 1.000 habitantes.",
    "Camas hospitalarias disponibles para atención aguda y crónica por cada 1.000 habitantes."
  ),
  Interpretación = c(
    "• >1,000 USD: alta inversión<br>• 200-1,000 USD: inversión intermedia<br>• <200 USD: baja inversión sanitaria",
    "• <20%: alta protección estatal<br>• 20-40%: protección moderada<br>• >40%: alto riesgo financiero familiar",
    "• >3.0: alta densidad de médicos<br>• 1.5-3.0: cobertura intermedia<br>• <1.5: déficit de personal médico",
    "• >6.0: alta densidad asistencial<br>• 2.5-6.0: nivel intermedio<br>• <2.5: escasez severa de personal",
    "• >4.0: alta capacidad hospitalaria<br>• 2.0-4.0: capacidad intermedia<br>• <2.0: infraestructura reducida"
  )
)

# 2. Renderizar la Tabla 2 con el paquete gt
tabla_2 <- variables_infraestructura %>%
  gt() %>%
  fmt_markdown(columns = Interpretación) %>%
  cols_width(
    Variable ~ px(190),
    Descripción ~ px(290),
    Interpretación ~ px(220)
  ) %>%
  tab_header(
    title = md("**Tabla 2: Variables de Infraestructura y Recursos del Sistema de Salud y su Interpretación**")
  ) %>%
  cols_label(
    Variable = md("**Variable**"),
    Descripción = md("**Descripción**"),
    Interpretación = md("**Interpretación**")
  ) %>%
  cols_align(
    align = "left",
    columns = everything()
  ) %>%
  tab_style(
    style = list(
      cell_text(weight = "bold", size = "medium", color = "white"),
      cell_fill(color = "#FF0000")
    ),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "white"),
      cell_text(color = "#333333")
    ),
    locations = cells_body()
  ) %>%
  tab_style(
    style = cell_text(weight = "bold", color = "#FF0000"),
    locations = cells_body(columns = Variable)
  ) %>%
  tab_style(
    style = cell_text(size = "small", color = "#333333"),
    locations = cells_body(columns = c(Descripción, Interpretación))
  ) %>%
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "#FF0000", size = "large")
    ),
    locations = cells_title(groups = "title")
  ) %>%
  tab_options(
    table.font.names = c("Times New Roman", "Georgia", "serif"),
    table.width = px(700),
    table.align = "center",
    table.border.top.style = "none",
    table.border.bottom.style = "none",
    column_labels.border.top.style = "none",
    table.background.color = "white",
    data_row.padding = px(7),
    heading.title.font.size = 17,
    heading.padding = px(12),
    footnotes.padding = px(7),
    footnotes.font.size = 14,
    source_notes.font.size = 14,
    source_notes.padding = px(7)
  ) %>%
  tab_source_note(
    source_note = md("**Fuentes:** Elaboración propia con base en Banco Mundial (2022) y OMS.")
  ) %>%
  opt_css(
    css = "
    .gt_table {
      border: none !important;
      border-collapse: separate !important;
      border-spacing: 0 !important;
    }
    
    /* Marco superior y esquinas superiores */
    .gt_column_heading {
      border-top: 2px solid #FF0000 !important;
      border-bottom: 2px solid #FF0000 !important;
    }
    .gt_column_heading:first-child {
      border-left: 2px solid #FF0000 !important;
      border-top-left-radius: 12px !important;
    }
    .gt_column_heading:last-child {
      border-right: 2px solid #FF0000 !important;
      border-top-right-radius: 12px !important;
    }
    
    /* Líneas internas (del medio) ultra delgadas: 0.5px */
    .gt_table_body tr td {
      border-right: 0.5px solid #FF0000 !important;
      border-bottom: 0.5px solid #FF0000 !important;
    }
    
    /* Paredes laterales exteriores del cuerpo: 2px */
    .gt_table_body tr td:first-child {
      border-left: 2px solid #FF0000 !important;
    }
    .gt_table_body tr td:last-child {
      border-right: 2px solid #FF0000 !important;
    }
    
    /* Base inferior del marco y esquinas inferiores redondeadas: 2px */
    .gt_table_body tr:last-child td {
      border-bottom: 2px solid #FF0000 !important;
    }
    .gt_table_body tr:last-child td:first-child {
      border-bottom-left-radius: 12px !important;
    }
    .gt_table_body tr:last-child td:last-child {
      border-bottom-right-radius: 12px !important;
    }
    "
 ) 

# 3. Imprimir tabla
tabla_2

Variable	Descripción	Interpretación
Tabla 2: Variables de Infraestructura y Recursos del Sistema de Salud y su Interpretación
Gasto corriente en salud pc (US$)	Gasto público y privado total en bienes y servicios de salud consumidos por habitante en dólares corrientes.	• >1,000 USD: alta inversión • 200-1,000 USD: inversión intermedia • <200 USD: baja inversión sanitaria
Gasto de bolsillo (% gasto salud)	Porcentaje del gasto total en salud pagado directamente del bolsillo de los hogares.	• <20%: alta protección estatal • 20-40%: protección moderada • >40%: alto riesgo financiero familiar
Médicos (por 1.000 personas)	Número de médicos generales y especialistas con ejercicio activo disponible por cada 1.000 habitantes.	• >3.0: alta densidad de médicos • 1.5-3.0: cobertura intermedia • <1.5: déficit de personal médico
Enfermería y partería (por 1.000 p.)	Número de enfermeros y parteros calificados en servicio activo por cada 1.000 habitantes.	• >6.0: alta densidad asistencial • 2.5-6.0: nivel intermedio • <2.5: escasez severa de personal
Camas de hospital (por 1.000 p.)	Camas hospitalarias disponibles para atención aguda y crónica por cada 1.000 habitantes.	• >4.0: alta capacidad hospitalaria • 2.0-4.0: capacidad intermedia • <2.0: infraestructura reducida
Fuentes: Elaboración propia con base en Banco Mundial (2022) y OMS.

Conclusión. La Tabla 2 describe con qué recursos cuenta cada país para atender a su población: dinero, personal y capacidad hospitalaria.

Inversión: los países se reparten en tercios casi iguales: 63 (33 %) invierten menos de US$200 por persona, 72 (37 %) están en el nivel intermedio y 58 (30 %) superan los US$1.000.
Protección financiera: 54 países (28 %) están en alto riesgo, porque los hogares pagan más del 40 % del gasto en salud directamente de su bolsillo.
Personal y camas: 51 países tienen déficit de médicos (menos de 1,5 por cada 1.000 habitantes) y 45 tienen escasez de personal de enfermería. El nivel intermedio de estas tres variables está inflado: de los 94 países con densidad intermedia de médicos, 72 no tenían dato y recibieron el valor de la mediana (2,24).
Para el análisis: esta dimensión mezcla variables de cantidad (gasto, médicos, camas) con una de financiamiento (gasto de bolsillo), así que no esperamos que todas se comporten igual.

2.2.3 Dimensión de medicina preventiva factores de riesgo

Evalúa la capacidad estructural de una nación para anticiparse a la carga de enfermedad mediante la intervención temprana y la mitigación de amenazas a la salud pública. En el marco de este estudio sobre 193 países, analizar este eje permite determinar qué tan eficientes son los países al evitar la aparición de patologías crónicas y reducir costos asistenciales futuros, transformando el enfoque de salud desde la curación hacia la preservación del bienestar.

library(dplyr)
library(gt)

# 1. Definir las 5 variables de Medicina Preventiva y Factores de Riesgo
variables_preventiva <- data.frame(
  Variable = c(
    "Prevalencia consumo tabaco (%)",
    "Prevalencia desnutrición (%)",
    "Prevalencia sobrepeso adultos (%)",
    "Inmunización sarampión (%)",
    "Inmunización DPT (%)"
  ),
  Descripción = c(
    "Porcentaje de la población adulta (≥15 años) que consume habitualmente productos derivados del tabaco.",
    "Porcentaje de la población cuyo consumo de alimentos es insuficiente para cubrir sus necesidades energéticas.",
    "Porcentaje de adultos (≥18 años) con Índice de Masa Corporal (IMC) mayor o igual a 25 kg/m².",
    "Porcentaje de niños entre 12 y 23 meses que han recibido la vacuna contra el sarampión.",
    "Porcentaje de niños entre 12 y 23 meses vacunados contra difteria, tos ferina y tétanos."
  ),
  Interpretación = c(
    "• >25%: alta prevalencia de tabaquismo<br>• 15-25%: nivel moderado<br>• <15%: baja prevalencia",
    "• <2.5%: alta seguridad alimentaria<br>• 2.5-10%: vulnerabilidad moderada<br>• >10%: alta desnutrición",
    "• >60%: alta prevalencia de sobrepeso<br>• 40-60%: nivel intermedio<br>• <40%: baja prevalencia",
    "• >90%: alta cobertura (inmunidad rebaño)<br>• 80-90%: cobertura moderada<br>• <80%: alto riesgo de brotes",
    "• >90%: esquema preventivo sólido<br>• 80-90%: cobertura aceptable<br>• <80%: baja cobertura de vacunación"
  )
)

# 2. Renderizar la Tabla 3 con el paquete gt
tabla_3 <- variables_preventiva %>%
  gt() %>%
  fmt_markdown(columns = Interpretación) %>%
  cols_width(
    Variable ~ px(190),
    Descripción ~ px(290),
    Interpretación ~ px(220)
  ) %>%
  tab_header(
    title = md("**Tabla 3: Variables de Medicina Preventiva y Factores de Riesgo y su Interpretación**")
  ) %>%
  cols_label(
    Variable = md("**Variable**"),
    Descripción = md("**Descripción**"),
    Interpretación = md("**Interpretación**")
  ) %>%
  cols_align(
    align = "left",
    columns = everything()
  ) %>%
  tab_style(
    style = list(
      cell_text(weight = "bold", size = "medium", color = "white"),
      cell_fill(color = "#FF0000")
    ),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "white"),
      cell_text(color = "#333333")
    ),
    locations = cells_body()
  ) %>%
  tab_style(
    style = cell_text(weight = "bold", color = "#FF0000"),
    locations = cells_body(columns = Variable)
  ) %>%
  tab_style(
    style = cell_text(size = "small", color = "#333333"),
    locations = cells_body(columns = c(Descripción, Interpretación))
  ) %>%
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "#FF0000", size = "large")
    ),
    locations = cells_title(groups = "title")
  ) %>%
  tab_options(
    table.font.names = c("Times New Roman", "Georgia", "serif"),
    table.width = px(700),
    table.align = "center",
    table.border.top.style = "none",
    table.border.bottom.style = "none",
    column_labels.border.top.style = "none",
    table.background.color = "white",
    data_row.padding = px(7),
    heading.title.font.size = 17,
    heading.padding = px(12),
    footnotes.padding = px(7),
    footnotes.font.size = 14,
    source_notes.font.size = 14,
    source_notes.padding = px(7)
  ) %>%
  tab_source_note(
    source_note = md("**Fuentes:** Elaboración propia con base en Banco Mundial (2022), OMS y FAO.")
  ) %>%
  opt_css(
    css = "
    .gt_table {
      border: none !important;
      border-collapse: separate !important;
      border-spacing: 0 !important;
    }
    
    /* Marco superior y esquinas superiores */
    .gt_column_heading {
      border-top: 2px solid #FF0000 !important;
      border-bottom: 2px solid #FF0000 !important;
    }
    .gt_column_heading:first-child {
      border-left: 2px solid #FF0000 !important;
      border-top-left-radius: 12px !important;
    }
    .gt_column_heading:last-child {
      border-right: 2px solid #FF0000 !important;
      border-top-right-radius: 12px !important;
    }
    
    /* Líneas internas (del medio) ultra delgadas: 0.5px */
    .gt_table_body tr td {
      border-right: 0.5px solid #FF0000 !important;
      border-bottom: 0.5px solid #FF0000 !important;
    }
    
    /* Paredes laterales exteriores del cuerpo: 2px */
    .gt_table_body tr td:first-child {
      border-left: 2px solid #FF0000 !important;
    }
    .gt_table_body tr td:last-child {
      border-right: 2px solid #FF0000 !important;
    }
    
    /* Base inferior del marco y esquinas inferiores redondeadas: 2px */
    .gt_table_body tr:last-child td {
      border-bottom: 2px solid #FF0000 !important;
    }
    .gt_table_body tr:last-child td:first-child {
      border-bottom-left-radius: 12px !important;
    }
    .gt_table_body tr:last-child td:last-child {
      border-bottom-right-radius: 12px !important;
    }
    "
  )

# 3. Imprimir tabla
tabla_3

Variable	Descripción	Interpretación
Tabla 3: Variables de Medicina Preventiva y Factores de Riesgo y su Interpretación
Prevalencia consumo tabaco (%)	Porcentaje de la población adulta (≥15 años) que consume habitualmente productos derivados del tabaco.	• >25%: alta prevalencia de tabaquismo • 15-25%: nivel moderado • <15%: baja prevalencia
Prevalencia desnutrición (%)	Porcentaje de la población cuyo consumo de alimentos es insuficiente para cubrir sus necesidades energéticas.	• <2.5%: alta seguridad alimentaria • 2.5-10%: vulnerabilidad moderada • >10%: alta desnutrición
Prevalencia sobrepeso adultos (%)	Porcentaje de adultos (≥18 años) con Índice de Masa Corporal (IMC) mayor o igual a 25 kg/m².	• >60%: alta prevalencia de sobrepeso • 40-60%: nivel intermedio • <40%: baja prevalencia
Inmunización sarampión (%)	Porcentaje de niños entre 12 y 23 meses que han recibido la vacuna contra el sarampión.	• >90%: alta cobertura (inmunidad rebaño) • 80-90%: cobertura moderada • <80%: alto riesgo de brotes
Inmunización DPT (%)	Porcentaje de niños entre 12 y 23 meses vacunados contra difteria, tos ferina y tétanos.	• >90%: esquema preventivo sólido • 80-90%: cobertura aceptable • <80%: baja cobertura de vacunación
Fuentes: Elaboración propia con base en Banco Mundial (2022), OMS y FAO.

Conclusión. La Tabla 3 combina dos tipos de indicadores: los que muestran la capacidad de prevenir enfermedades (vacunación) y los que miden riesgos ya presentes en la población (tabaco, desnutrición y sobrepeso).

Fortaleza: la vacunación es el área con mejores resultados: 110 países (57 %) tienen un esquema DPT sólido (más del 90 %) y 100 (52 %) superan el 90 % en sarampión.
Riesgos extendidos: 68 países (35 %) tienen más del 60 % de sus adultos con sobrepeso, 53 (27 %) tienen desnutrición alta y 51 (26 %) tienen más del 25 % de fumadores.
Brecha preventiva: aun así, 50 países (26 %) vacunan contra el sarampión a menos del 80 % de los niños, el nivel en el que aumenta el riesgo de brotes.
Para el análisis: los riesgos no siguen la misma dirección: la desnutrición se asocia con pobreza, mientras que el sobrepeso y el tabaco aparecen también en países de ingreso medio y alto.

2.2.4 Dimensión de dinámica demográfica

Analiza la estructura, evolución y distribución territorial de la población, elementos que configuran de manera directa el volumen y la naturaleza de la demanda asistencial en cada nación. Variables como las tasas de natalidad y fecundidad, la proporción de población en edad de dependencia, los patrones de urbanización y el ritmo de envejecimiento poblacional condicionan el margen de respuesta de los gobiernos.

library(dplyr)
library(gt)

# 1. Definir las 2 variables de Dinámica Demográfica
variables_demografica <- data.frame(
  Variable = c(
    "Tasa bruta de natalidad (‰)",
    "Tasa de fertilidad total (hijos/mujer)"
  ),
  Descripción = c(
    "Número de nacimientos vivos registrados anualmente por cada 1.000 habitantes.",
    "Número promedio de hijos que tendría una mujer al final de su vida reproductiva si se mantuviera constante la fecundidad por edad."
  ),
  Interpretación = c(
    "• >25‰: natalidad alta (población joven)<br>• 12-25‰: natalidad intermedia<br>• <12‰: natalidad baja (envejecimiento)",
    "• >3.0: alta fecundidad<br>• 2.1-3.0: reemplazo generacional<br>• <2.1: subreemplazo generacional"
  )
)

# 2. Renderizar la Tabla 4 con el paquete gt
tabla_4 <- variables_demografica %>%
  gt() %>%
  fmt_markdown(columns = Interpretación) %>%
  cols_width(
    Variable ~ px(190),
    Descripción ~ px(290),
    Interpretación ~ px(220)
  ) %>%
  tab_header(
    title = md("**Tabla 4: Variables de Dinámica Demográfica y su Interpretación**")
  ) %>%
  cols_label(
    Variable = md("**Variable**"),
    Descripción = md("**Descripción**"),
    Interpretación = md("**Interpretación**")
  ) %>%
  cols_align(
    align = "left",
    columns = everything()
  ) %>%
  tab_style(
    style = list(
      cell_text(weight = "bold", size = "medium", color = "white"),
      cell_fill(color = "#FF0000")
    ),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "white"),
      cell_text(color = "#333333")
    ),
    locations = cells_body()
  ) %>%
  tab_style(
    style = cell_text(weight = "bold", color = "#FF0000"),
    locations = cells_body(columns = Variable)
  ) %>%
  tab_style(
    style = cell_text(size = "small", color = "#333333"),
    locations = cells_body(columns = c(Descripción, Interpretación))
  ) %>%
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "#FF0000", size = "large")
    ),
    locations = cells_title(groups = "title")
  ) %>%
  tab_options(
    table.font.names = c("Times New Roman", "Georgia", "serif"),
    table.width = px(700),
    table.align = "center",
    table.border.top.style = "none",
    table.border.bottom.style = "none",
    column_labels.border.top.style = "none",
    table.background.color = "white",
    data_row.padding = px(7),
    heading.title.font.size = 17,
    heading.padding = px(12),
    footnotes.padding = px(7),
    footnotes.font.size = 14,
    source_notes.font.size = 14,
    source_notes.padding = px(7)
  ) %>%
  tab_source_note(
    source_note = md("**Fuentes:** Elaboración propia con base en Banco Mundial (2022) y División de Población de las Naciones Unidas.")
  ) %>%
  opt_css(
    css = "
    .gt_table {
      border: none !important;
      border-collapse: separate !important;
      border-spacing: 0 !important;
    }
    
    /* Marco superior y esquinas superiores */
    .gt_column_heading {
      border-top: 2px solid #FF0000 !important;
      border-bottom: 2px solid #FF0000 !important;
    }
    .gt_column_heading:first-child {
      border-left: 2px solid #FF0000 !important;
      border-top-left-radius: 12px !important;
    }
    .gt_column_heading:last-child {
      border-right: 2px solid #FF0000 !important;
      border-top-right-radius: 12px !important;
    }
    
    /* Líneas internas (del medio) ultra delgadas: 0.5px */
    .gt_table_body tr td {
      border-right: 0.5px solid #FF0000 !important;
      border-bottom: 0.5px solid #FF0000 !important;
    }
    
    /* Paredes laterales exteriores del cuerpo: 2px */
    .gt_table_body tr td:first-child {
      border-left: 2px solid #FF0000 !important;
    }
    .gt_table_body tr td:last-child {
      border-right: 2px solid #FF0000 !important;
    }
    
    /* Base inferior del marco y esquinas inferiores redondeadas: 2px */
    .gt_table_body tr:last-child td {
      border-bottom: 2px solid #FF0000 !important;
    }
    .gt_table_body tr:last-child td:first-child {
      border-bottom-left-radius: 12px !important;
    }
    .gt_table_body tr:last-child td:last-child {
      border-bottom-right-radius: 12px !important;
    }
    "
  )

# 3. Imprimir tabla
tabla_4

Variable	Descripción	Interpretación
Tabla 4: Variables de Dinámica Demográfica y su Interpretación
Tasa bruta de natalidad (‰)	Número de nacimientos vivos registrados anualmente por cada 1.000 habitantes.	• >25‰: natalidad alta (población joven) • 12-25‰: natalidad intermedia • <12‰: natalidad baja (envejecimiento)
Tasa de fertilidad total (hijos/mujer)	Número promedio de hijos que tendría una mujer al final de su vida reproductiva si se mantuviera constante la fecundidad por edad.	• >3.0: alta fecundidad • 2.1-3.0: reemplazo generacional • <2.1: subreemplazo generacional
Fuentes: Elaboración propia con base en Banco Mundial (2022) y División de Población de las Naciones Unidas.

Conclusión. La Tabla 4 resume la estructura demográfica, que determina cuánta demanda de atención tiene cada sistema de salud y de qué tipo.

Dos realidades: 99 países (51 %) ya están por debajo del reemplazo generacional (menos de 2,1 hijos por mujer), mientras que 55 países (28 %) superan los 3 hijos por mujer.
Natalidad: 75 países (39 %) tienen natalidad baja (menos de 12 nacimientos por cada 1.000 habitantes) y 53 (27 %) la tienen alta (más de 25).
Implicación sanitaria: los países con natalidad baja enfrentan el envejecimiento de su población, y los de natalidad alta deben atender una gran demanda de salud materna e infantil.
Para el análisis: natalidad y fertilidad miden casi lo mismo, por lo que en el ACP deberían aparecer prácticamente juntas.

2.3 Base de datos

library(readxl)
library(dplyr)
library(tidyr)
library(DT)
library(htmltools)
library(htmlwidgets)

# Cargar la base de datos completa de Salud y Nutrición (193 entidades)
Base_2022 <- read_excel("Base de datos de salud y nutricion.xlsx", sheet = "Data") %>%
  filter(!is.na(`Country Name`), !is.na(`Series Code`)) %>%
  filter(!`Series Code` %in% c("Data from database: Health Nutrition and Population Statistics", "Last Updated: 07/01/2026")) %>%
  mutate(Valor = as.numeric(`2022 [YR2022]`)) %>%
  select(Pais = `Country Name`, Codigo = `Country Code`, Series = `Series Code`, Valor) %>%
  pivot_wider(names_from = Series, values_from = Valor) %>%
  select(
    Pais,
    Codigo,
    `Esperanza vida` = SP.DYN.LE00.IN,
    `Mortalidad infantil` = SH.DYN.MORT,
    `Mortalidad materna` = SH.STA.MMRT,
    `Gasto salud pc` = SH.XPD.CHEX.PC.CD,
    `Gasto bolsillo` = SH.XPD.OOPC.CH.ZS,
    Medicos = SH.MED.PHYS.ZS,
    Enfermeria = SH.MED.NUMW.P3,
    `Camas hospital` = SH.MED.BEDS.ZS,
    Tabaquismo = SH.PRV.SMOK,
    Desnutricion = SN.ITK.DEFC.ZS,
    Sobrepeso = SH.STA.OWAD.ZS,
    `Inmunizacion sarampion` = SH.IMM.MEAS,
    `Inmunizacion DPT` = SH.IMM.IDPT,
    Natalidad = SP.DYN.CBRT.IN,
    Fertilidad = SP.DYN.TFRT.IN
  )%>%
  mutate(across(where(is.numeric), ~ ifelse(is.na(.), round(median(., na.rm = TRUE), 2), .)))

# 2. Encabezados descriptivos en español
nombres_columnas <- c(
  "País", "Código", "Esperanza de vida", "Mortalidad infantil", "Mortalidad materna",
  "Gasto salud pc", "Gasto de bolsillo", "Médicos", "Enfermería", "Camas hospital",
  "Tabaquismo", "Desnutrición", "Sobrepeso adultos", "Vacunación sarampión", "Vacunación DPT",
  "Tasa natalidad", "Tasa fertilidad"
)

# 3. Renderizar la tabla interactiva con las 193 entidades
tabla_inicial <- datatable(
  Base_2022,
  extensions = c('Buttons', 'Scroller', 'Responsive'),
  options = list(
    dom = '<"tabla-header"B>frtip',
    buttons = list(
      list(extend = 'copy', text = '📋 Copiar', className = 'btn-red'),
      list(extend = 'csv', text = '📊 CSV', className = 'btn-red'),
      list(extend = 'excel', text = '📈 Excel', className = 'btn-red'),
      list(extend = 'pdf', text = '📄 PDF', className = 'btn-red'),
      list(extend = 'print', text = '🖨️ Imprimir', className = 'btn-red')
    ),
    pageLength = 12,
    lengthMenu = list(c(8, 12, 20, 50, -1), c('8', '12', '20', '50', 'Todos')),
    scrollX = TRUE,
    scrollY = "500px",
    scroller = TRUE,
    deferRender = TRUE,
    autoWidth = FALSE,
    responsive = FALSE,
    language = list(
      url = '//cdn.datatables.net/plug-ins/1.13.4/i18n/es-ES.json',
      search = "🔍 Buscar:",
      lengthMenu = "Mostrar _MENU_ registros",
      info = "_START_ - _END_ de _TOTAL_ países",
      paginate = list(
        first = "⏮️",
        last = "⏭️",
        `next` = "➡️",
        previous = "⬅️"
      )
    )
  ),
  rownames = FALSE,
  class = c('display', 'compact', 'hover', 'nowrap'),
  caption = htmltools::HTML(
    '<div style="color: #FF0000; font-size: 16px; font-weight: bold; 
    margin-bottom: 12px; text-align: left; text-transform: uppercase; letter-spacing: 1px;">
    Tabla 6: Dataset Completo - Variables de Salud y Nutrición Global 2022
    </div>'
  ),
  colnames = nombres_columnas
) %>%
  formatCurrency(
    columns = 'Gasto salud pc', 
    currency = "$", 
    digits = 0,
    before = TRUE
  ) %>%
  formatRound(
    columns = c('Esperanza vida', 'Gasto bolsillo', 'Medicos', 'Enfermeria', 
                'Camas hospital', 'Tabaquismo', 'Desnutricion', 'Sobrepeso', 
                'Inmunizacion sarampion', 'Inmunizacion DPT', 'Natalidad', 'Fertilidad'), 
    digits = 2
  ) %>%
  formatRound(
    columns = c('Mortalidad infantil', 'Mortalidad materna'),
    digits = 1
  ) %>%
  htmlwidgets::onRender("
    function(el, x) {
      var style = document.createElement('style');
      style.innerHTML = `
        table.dataTable thead th,
        table.dataTable thead td,
        .dataTables_scrollHead table.dataTable thead th,
        .dataTables_scrollHeadInner table thead th,
        .dataTables_scrollHeadInner table thead th.sorting,
        .dataTables_scrollHeadInner table thead th.sorting_asc,
        .dataTables_scrollHeadInner table thead th.sorting_desc {
          background: #FF0000 !important;
          background-color: #FF0000 !important;
          background-image: none !important;
          color: #ffffff !important;
          border: 1px solid #ffffff !important;
          font-weight: bold !important;
          font-family: 'Times New Roman', Georgia, serif !important;
        }

        .dt-button, .btn-red {
          background: #FF0000 !important;
          background-color: #FF0000 !important;
          background-image: none !important;
          color: #ffffff !important;
          border: 1px solid #b30000 !important;
          border-radius: 5px !important;
          padding: 8px 14px !important;
          font-size: 12px !important;
          font-weight: bold !important;
        }
        .dt-button:hover, .btn-red:hover {
          background: #b30000 !important;
          background-color: #b30000 !important;
        }

        .dataTables_wrapper {
          background: #ffffff !important;
          border: 2px solid #FF0000 !important;
          border-radius: 10px !important;
          padding: 15px !important;
          box-shadow: 0 4px 15px rgba(255, 0, 0, 0.08) !important;
          font-family: 'Times New Roman', Georgia, serif !important;
          max-width: 100% !important;
          box-sizing: border-box !important;
        }

        .dataTables_scrollBody {
          border: 1px solid #FF0000 !important;
          border-radius: 6px !important;
        }
      `;
      document.head.appendChild(style);
    }
  ")

tabla_inicial

Conclusión. La Tabla 6 es la base completa con la que trabajamos: 193 economías y 15 indicadores de 2022, es decir, 2.895 datos.

Datos completados: en la descarga original faltaban 331 datos (11,4 % de la base). Al cargar la base, cada dato faltante se reemplaza por la mediana de su variable.
Dónde estaban los vacíos: casi todos se concentraban en camas de hospital (84 países), médicos (72), enfermería (71), desnutrición (35) y tabaquismo (32). Las variables demográficas y la esperanza de vida estaban completas.
Qué implica: en esas cinco variables muchos países comparten exactamente el mismo valor, lo que reduce su dispersión. Por eso sus resultados se deben leer con más cautela que los de las variables completas.
Composición: la base incluye todos los países y territorios con datos en el Banco Mundial, entre ellos la República Centroafricana, que tiene los valores más extremos de varias variables.

2.4 Preparación de los datos para el modelo

# Estilo de las tablas del modelo (el mismo rojo de las tablas anteriores)
tabla_t3 <- function(df, titulo, ancho = 760, fuente = "Elaboración propia con base en Banco Mundial (2022).") {
  df %>%
    gt() %>%
    tab_header(title = html(paste0("<b>", titulo, "</b>"))) %>%
    tab_style(style = list(cell_text(weight = "bold", color = "white"), cell_fill(color = "#FF0000")),
              locations = cells_column_labels()) %>%
    tab_style(style = cell_text(weight = "bold", color = "#FF0000", size = "large"),
              locations = cells_title(groups = "title")) %>%
    tab_options(table.font.names = c("Times New Roman", "Georgia", "serif"),
                table.width = px(ancho), table.align = "center", data_row.padding = px(5)) %>%
    tab_source_note(source_note = html(paste0("<b>Fuente:</b> ", fuente)))
}

tema_t3 <- function() {
  theme_minimal(base_size = 12) +
    theme(plot.title = element_text(face = "bold", color = "#FF0000"),
          strip.text = element_text(face = "bold", color = "#990000"),
          panel.grid.minor = element_blank())
}

# Colores de los clusters (azul, dorado, rojo, ...)
paleta_cl <- c("#1c5cab", "#E0A800", "#CC0000", "#2CA02C", "#6A1B9A", "#00838F")

# Variables del modelo (mismo orden de la base) y etiquetas cortas
vars_mod <- names(Base_2022)[3:ncol(Base_2022)]
etiquetas_mod <- c("Esperanza de vida", "ln Mortalidad infantil", "ln Mortalidad materna", "ln Gasto salud pc",
                   "Gasto de bolsillo", "Médicos", "Enfermería", "Camas hospital", "Tabaquismo", "Desnutrición",
                   "Sobrepeso", "Vacunación sarampión", "Vacunación DPT", "Natalidad", "Fertilidad")
vars_log <- c("Mortalidad infantil", "Mortalidad materna", "Gasto salud pc")
stopifnot(length(vars_mod) == 15, all(vars_log %in% vars_mod))

En el análisis descriptivo quedaron tres decisiones pendientes: qué hacer con la República Centroafricana, cómo tratar la fuerte asimetría de algunas variables y cómo tratar los datos faltantes. Las resolvemos aquí, antes de ajustar el ACP.

2.4.1 Decisión 1: países que se excluyen

pais_atipico <- "Central African Republic"
umbral_na <- 0.30

# Proporción de las 15 variables sin dato en cada país
prop_na_pais <- rowMeans(is.na(as.data.frame(Base_2022[, vars_mod])))
excl_na <- Base_2022$Pais[prop_na_pais > umbral_na & Base_2022$Pais != pais_atipico]
Base_modelo <- Base_2022[prop_na_pais <= umbral_na & Base_2022$Pais != pais_atipico, ]

# Valores de la República Centroafricana frente al resto de países
car <- Base_2022[Base_2022$Pais == pais_atipico, ]
mi_ord <- Base_2022[order(-Base_2022$`Mortalidad infantil`), c("Pais", "Mortalidad infantil")]
ev_ord <- Base_2022[order(Base_2022$`Esperanza vida`), c("Pais", "Esperanza vida")]
car_mi <- car$`Mortalidad infantil`
car_ev <- car$`Esperanza vida`
seg_mi <- mi_ord[[2, 2]]; seg_mi_pais <- mi_ord[[2, 1]]
seg_ev <- ev_ord[[2, 2]]; seg_ev_pais <- ev_ord[[2, 1]]

La República Centroafricana aparece con una esperanza de vida de 18,8 años y una mortalidad en menores de 5 años de 424,6 ‰. El siguiente país con menor esperanza de vida es Somalia, Fed. Rep. (53,9 años) y el siguiente con mayor mortalidad infantil es Somalia, Fed. Rep. (143,1 ‰). Son valores tan alejados del resto que, una vez estandarizados, un solo país dominaría los primeros componentes y distorsionaría las correlaciones. Por eso lo dejamos fuera del modelo y lo conservamos solo en el análisis descriptivo. Más adelante comprobamos qué pasa si se incluye de nuevo.

También excluimos 0 países que tienen más del 30 % de las 15 variables sin dato (), porque completar casi todo un país con valores estimados no tiene sustento. El modelo queda con 192 países.

2.4.2 Decisión 2: transformación logarítmica

# Matriz del modelo: logaritmo natural en gasto y mortalidades

M0 <- as.matrix(Base_2022[, vars_mod])
M0[, vars_log] <- log(M0[, vars_log])
colnames(M0) <- etiquetas_mod
rownames(M0) <- Base_2022$Pais

asim_tab <- tibble(
  Variable = vars_log,
  `Asimetría original` = sapply(vars_log, function(v) asimetria(Base_2022[[v]])),
  `Asimetría con logaritmo` = sapply(vars_log, function(v) asimetria(log(Base_modelo[[v]])))
)

asim_tab %>%
  tabla_t3("Tabla 9: Asimetría de las variables transformadas", ancho = 600) %>%
  fmt_number(columns = c(`Asimetría original`, `Asimetría con logaritmo`),
             decimals = 2, sep_mark = ".", dec_mark = ",") %>%
  tab_style(style = cell_text(weight = "bold", color = "#FF0000"), locations = cells_body(columns = Variable))

Variable	Asimetría original	Asimetría con logaritmo
Tabla 9: Asimetría de las variables transformadas
Mortalidad infantil	6,14	−0,03
Mortalidad materna	2,46	−0,19
Gasto salud pc	2,58	0,09
Fuente: Elaboración propia con base en Banco Mundial (2022).

El gasto en salud per cápita y las dos mortalidades tenían una asimetría positiva muy alta: unos pocos países con valores enormes jalaban la media. Con el logaritmo natural la asimetría baja a valores cercanos a cero (Tabla 9), así que ya no mandan los casos extremos y la relación con las demás variables se parece más a una recta, que es lo que mide la correlación. En las tablas siguientes las variables transformadas aparecen con el prefijo ln.

Conclusión. La Tabla 9 muestra que el logaritmo corrige casi por completo la asimetría de las tres variables más sesgadas.

Mortalidad infantil: pasa de una asimetría de 6,14 a -0,03, la corrección más grande, porque era la variable con la cola más larga.
Mortalidad materna: baja de 2,46 a -0,19.
Gasto en salud per cápita: baja de 2,58 a 0,09.
Lectura: con valores tan cercanos a cero, las tres variables quedan prácticamente simétricas. Así, los países con valores extremos dejan de dominar las medias y las correlaciones.

2.5 Descripción del modelo

Para extraer patrones estructurales implícitos y tipificar la situación sanitaria global a partir de las 15 variables cuantitativas del Banco Mundial (2022), se aplica un enfoque multivariado secuencial basado en Análisis de Componentes Principales (ACP) seguido de Clusterización Jerárquica.

2.5.1 Justificación del análisis de componentes principales (ACP)

Las dimensiones del bienestar humano (longevidad, infraestructura, medicina preventiva y demografía) presentan un alto grado de interdependencia y multicolinealidad. Por ejemplo, un elevado gasto per cápita en salud suele correlacionarse directamente con una mayor densidad de personal médico, altas coberturas de vacunación y reducidas tasas de mortalidad infantil.El ACP resuelve esta redundancia informacional mediante la transformación lineal del conjunto original de $p = 15$ variables correlacionadas en un nuevo conjunto de variables no correlacionadas (ortogonales) denominadas componentes principales ($PC_1, PC_2, \dots, PC_k$), ordenadas decrecientemente según la proporción de varianza total explicada.

2.5.2 Pruebas de diagnóstico y factibilidad

Antes de interpretar las dimensiones sintéticas, se evalúa si la matriz de correlaciones de Pearson ($\mathbf{R}$) posee suficiente redundancia estructural para justificar el ACP:Prueba de Esfericidad de Bartlett: Evalúa la hipótesis nula $H_0: \mathbf{R} = \mathbf{I}$ (la matriz de correlación es una matriz identidad). Un valor $p < 0.05$ rechaza $H_0$, confirmando que existen correlaciones significativas entre las variables del sistema de salud.Índice Kaiser-Meyer-Olkin (KMO): Mide la adecuación muestral comparando la magnitud de las correlaciones observadas con las correlaciones parciales. Valores globales de KMO $> 0.70$ indican una factibilidad aceptable/buena para la extracción de factores principales.

2.5.3 Estrategia de clusterización jerárquica

Con el fin de clasificar a los 193 países en grupos homogéneos (clusters) y caracterizar los diferentes perfiles sanitarios internacionales, se aplica un Análisis de Cluster Jerárquico Aglomerativo alimentado directamente por las coordenadas del espacio reducido de componentes principales retenidos (evitando así el ruido estocástico de variables redundantes).

Se utiliza la Distancia Euclídea en el espacio factorial para cuantificar la disimilitud entre cada par de países $i$ y $j$:\[d(i,j) = \sqrt{\sum_{m=1}^{k} (PC_{i,m} - PC_{j,m})^2}\]
Se emplea el Método de Enlace de Ward (ward.D2), el cual minimiza la varianza dentro de cada cluster (suma de cuadrados de las desviaciones respecto al centroide del grupo). Este método genera clusters bien definidos, compactos y de tamaños equilibrados.
La determinación del número final de grupos se establece mediante el análisis del gráfico de dendrograma y la pérdida relativa de inercia inter-clase al pasar de k a k−1 conglomerados.

3 Analisis descriptivo

Antes de aplicar el Análisis de Componentes Principales (ACP) y agrupar a los países en clusters, es indispensable revisar cómo se comporta cada indicador por separado. Mientras que el ACP ayuda a descubrir patrones ocultos en los datos, la exploración descriptiva nos muestra a simple vista las diferencias y tendencias que anticipan esos resultados.

Este recorrido analiza 193 países a través de cuatro dimensiones clave: Longevidad y Salud Infantil/Materna, Infraestructura y Recursos del Sistema de Salud, Medicina Preventiva y Factores de Riesgo, y Dinámica Demográfica. Mediante tablas e indicadores interactivos, identificamos a las naciones líderes y rezagadas en cada área. Así se evidencia que la salud de un país no se mide con un solo número: un territorio puede tener grandes coberturas de vacunación y, al mismo tiempo, sufrir escasez de médicos, lo que confirma la necesidad de usar un modelo multivariado como el ACP.

library(dplyr)
library(gt)

# 1. Extraer nombres de todas las variables numéricas (columnas 3 a 17)
variables_numericas <- names(Base_2022)[3:ncol(Base_2022)]

# 2. Función unificada para generar estadísticas descriptivas y Top 10 estilizados
crear_tabla_unificada <- function(data, variable) {
  valores <- data[[variable]]
  
  # Métricas descriptivas
  total_paises <- sum(!is.na(valores))
  media        <- round(mean(valores, na.rm = TRUE), 2)
  mediana      <- round(median(valores, na.rm = TRUE), 2)
  desv_est     <- round(sd(valores, na.rm = TRUE), 2)
  q1           <- round(quantile(valores, 0.25, na.rm = TRUE), 2)
  q3           <- round(quantile(valores, 0.75, na.rm = TRUE), 2)
  minimo       <- round(min(valores, na.rm = TRUE), 2)
  maximo       <- round(max(valores, na.rm = TRUE), 2)
  
  # Dataframe de resumen de estadísticas
  df_estadisticas <- data.frame(
    Métrica = c("Total Países", "Media", "Mediana", "Desv. Est.", "Q1", "Q3", "Mínimo", "Máximo"),
    Valor   = c(total_paises, media, mediana, desv_est, q1, q3, minimo, maximo)
  )
  
  # Dataframe de los 10 países con mayor valor
  df_top10 <- data %>%
    select(Pais, Valor = all_of(variable)) %>%
    filter(!is.na(Valor)) %>%
    arrange(desc(Valor)) %>%
    head(10) %>%
    mutate(
      Ranking      = row_number(),
      Pct_vs_Media = round((Valor / media - 1) * 100, 1),
      Diferencia   = sprintf("<span style='color:%s; font-weight:bold;'>%s%.1f%%</span>",
                            ifelse(Pct_vs_Media >= 0, "#008000", "#d32f2f"),
                            ifelse(Pct_vs_Media >= 0, "+", ""),
                            Pct_vs_Media)
    ) %>%
    select(Ranking, País = Pais, Valor, `Diferencia vs Media` = Diferencia)
  
  # CSS compartido para mantener el estilo rojo redondeado
  css_rojo_redondeado <- "
    .gt_table {
      border: none !important;
      border-collapse: separate !important;
      border-spacing: 0 !important;
    }
    .gt_column_heading {
      border-top: 2px solid #FF0000 !important;
      border-bottom: 2px solid #FF0000 !important;
    }
    .gt_column_heading:first-child {
      border-left: 2px solid #FF0000 !important;
      border-top-left-radius: 12px !important;
    }
    .gt_column_heading:last-child {
      border-right: 2px solid #FF0000 !important;
      border-top-right-radius: 12px !important;
    }
    .gt_table_body tr td {
      border-right: 0.5px solid #FF0000 !important;
      border-bottom: 0.5px solid #FF0000 !important;
    }
    .gt_table_body tr td:first-child {
      border-left: 2px solid #FF0000 !important;
    }
    .gt_table_body tr td:last-child {
      border-right: 2px solid #FF0000 !important;
    }
    .gt_table_body tr:last-child td {
      border-bottom: 2px solid #FF0000 !important;
    }
    .gt_table_body tr:last-child td:first-child {
      border-bottom-left-radius: 12px !important;
    }
    .gt_table_body tr:last-child td:last-child {
      border-bottom-right-radius: 12px !important;
    }
  "

  # Renderizar Tabla 1: Resumen de Estadísticas
  gt_estadisticas <- df_estadisticas %>%
    gt() %>%
    tab_header(
      title = md(paste0("**Estadísticas Descriptivas: ", variable, "**"))
    ) %>%
    cols_align(align = "left", columns = Métrica) %>%
    cols_align(align = "right", columns = Valor) %>%
    tab_style(
      style = list(cell_text(weight = "bold", color = "white"), cell_fill(color = "#FF0000")),
      locations = cells_column_labels()
    ) %>%
    tab_style(
      style = cell_text(weight = "bold", color = "#FF0000"),
      locations = cells_body(columns = Métrica)
    ) %>%
    tab_style(
      style = cell_text(weight = "bold", color = "#FF0000", size = "large"),
      locations = cells_title(groups = "title")
    ) %>%
    tab_options(
      table.font.names = c("Times New Roman", "Georgia", "serif"),
      table.width = px(400),
      table.align = "center",
      data_row.padding = px(6),
      heading.padding = px(8)
    ) %>%
    opt_css(css = css_rojo_redondeado)

  # Renderizar Tabla 2: Ranking Top 10 Países
  gt_top10 <- df_top10 %>%
    gt() %>%
    fmt_markdown(columns = `Diferencia vs Media`) %>%
    tab_header(
      title = md(paste0("**Top 10 Países: ", variable, "**"))
    ) %>%
    cols_align(align = "center", columns = Ranking) %>%
    cols_align(align = "left", columns = País) %>%
    cols_align(align = "right", columns = c(Valor, `Diferencia vs Media`)) %>%
    tab_style(
      style = list(cell_text(weight = "bold", color = "white"), cell_fill(color = "#FF0000")),
      locations = cells_column_labels()
    ) %>%
    tab_style(
      style = cell_text(weight = "bold", color = "#FF0000"),
      locations = cells_body(columns = Ranking)
    ) %>%
    tab_style(
      style = cell_text(weight = "bold", color = "#FF0000", size = "large"),
      locations = cells_title(groups = "title")
    ) %>%
    tab_options(
      table.font.names = c("Times New Roman", "Georgia", "serif"),
      table.width = px(550),
      table.align = "center",
      data_row.padding = px(6),
      heading.padding = px(8)
    ) %>%
    opt_css(css = css_rojo_redondeado)

  # Retornar lista con los objetos de datos y tablas de gt
  list(
    datos_estadisticas = df_estadisticas,
    datos_top10        = df_top10,
    tabla_estadisticas = gt_estadisticas,
    tabla_top10        = gt_top10
  )
}

3.1 Calidad y cobertura de los datos

Antes de describir cada indicador revisamos cuántos países tienen información en 2022. Las variables demográficas y la esperanza de vida están completas, pero los indicadores de recursos del sistema de salud tienen muchos vacíos: las camas de hospital, los médicos y el personal de enfermería no tienen dato para más de un tercio de los países.

library(dplyr)
library(kableExtra)

# 1. Estilos CSS integrados para el diseño de dos columnas y tema rojo académico
cat('
<style>
.two-column-layout {
  display: flex;
  flex-wrap: wrap;
  gap: 20px;
  align-items: flex-start;
  margin-bottom: 28px;
}
.table-container {
  flex: 1 1 46%;
  min-width: 300px;
  background-color: #FFFFFF;
  border: 1px solid #FFE5E5;
  border-top: 3px solid #CC0000;
  border-radius: 8px;
  padding: 14px;
  box-shadow: 0 2px 6px rgba(153, 0, 0, 0.06);
}
.section-title {
  color: #990000;
  font-weight: bold;
  font-size: 15px;
  border-bottom: 2px solid #FFD100;
  padding-bottom: 5px;
  margin-top: 0;
  margin-bottom: 12px;
}
</style>
')

# 2. Detección segura de columna de país y variables numéricas
col_pais <- intersect(c("Pais", "País", "Country", "pais", "country"), names(Base_2022))
col_pais <- if (length(col_pais) > 0) col_pais[1] else names(Base_2022)[1]

if (!exists("variables_numericas")) {
  variables_numericas <- names(Base_2022)[3:ncol(Base_2022)]
  variables_numericas <- variables_numericas[sapply(Base_2022[variables_numericas], is.numeric)]
}

# 3. Función auxiliar que prepara los datos exactos para kbl()
obtener_datos_variable <- function(data, var_name) {
  valores <- as.numeric(data[[var_name]])
  
  total_paises <- sum(!is.na(valores))
  media        <- mean(valores, na.rm = TRUE)
  mediana      <- median(valores, na.rm = TRUE)
  desv_est     <- sd(valores, na.rm = TRUE)
  q1           <- as.numeric(quantile(valores, 0.25, na.rm = TRUE))
  q3           <- as.numeric(quantile(valores, 0.75, na.rm = TRUE))
  minimo       <- min(valores, na.rm = TRUE)
  maximo       <- max(valores, na.rm = TRUE)
  
  df_stats <- data.frame(
    Métrica = c("Total Países", "Media", "Mediana", "Desv. Est.", "Q1", "Q3", "Mínimo", "Máximo"),
    Valor   = c(
      as.character(total_paises),
      format(round(media, 2), nsmall = 2, big.mark = ".", decimal.mark = ","),
      format(round(mediana, 2), nsmall = 2, big.mark = ".", decimal.mark = ","),
      format(round(desv_est, 2), nsmall = 2, big.mark = ".", decimal.mark = ","),
      format(round(q1, 2), nsmall = 2, big.mark = ".", decimal.mark = ","),
      format(round(q3, 2), nsmall = 2, big.mark = ".", decimal.mark = ","),
      format(round(minimo, 2), nsmall = 2, big.mark = ".", decimal.mark = ","),
      format(round(maximo, 2), nsmall = 2, big.mark = ".", decimal.mark = ",")
    ),
    stringsAsFactors = FALSE
  )
  
  df_top <- data %>%
    select(País = all_of(col_pais), Valor_num = all_of(var_name)) %>%
    filter(!is.na(Valor_num)) %>%
    arrange(desc(Valor_num)) %>%
    head(10) %>%
    mutate(
      Ranking     = row_number(),
      Pct_val     = if (!is.na(media) && media != 0) round((Valor_num / media - 1) * 100, 1) else 0,
      Pct_Display = sprintf("%s%.1f%%", ifelse(Pct_val >= 0, "+", ""), Pct_val),
      Pct_Color   = ifelse(Pct_val >= 0, "#1B5E20", "#CC0000"),
      Valor       = format(round(Valor_num, 2), nsmall = 2, big.mark = ".", decimal.mark = ",")
    ) %>%
    select(Ranking, País, Valor, Pct_Display, Pct_Color)
  
  list(estadisticas = df_stats, top10 = df_top)
}

# 4. Bucle principal para renderizar cada variable en dos columnas
for (variable in variables_numericas) {
  cat(sprintf('\n\n#### %s {.unnumbered}\n\n', variable))
  
  datos <- obtener_datos_variable(Base_2022, variable)
  
  cat('<div class="two-column-layout">\n\n')
  
  # --- COLUMNA IZQUIERDA: Estadísticas Globales ---
  cat('<div class="table-container">\n\n')
  cat('<p class="section-title">Estadísticas Globales</p>\n\n')
  
  tabla_stats <- datos$estadisticas %>%
    kbl(
      align = c('l', 'r'),
      escape = FALSE,
      col.names = c("Métrica", "Valor")
    ) %>%
    kable_styling(
      bootstrap_options = c("striped", "hover"),
      full_width = TRUE,
      font_size = 13
    ) %>%
    row_spec(0, background = "#CC0000", color = "#FFFFFF", bold = TRUE, font_size = 13) %>%
    row_spec(1, background = "#FFF5F5", color = "#990000", bold = TRUE, font_size = 13) %>%
    row_spec(2:8, background = "#FFFFFF", color = "#2C2C2C") %>%
    column_spec(1, width = "14em", bold = TRUE, color = "#990000") %>%
    column_spec(2, width = "10em", color = "#2C2C2C", bold = TRUE)
  
  print(tabla_stats)
  cat('\n\n</div>\n\n')
  
  # --- COLUMNA DERECHA: Top 10 Países ---
  cat('<div class="table-container">\n\n')
  cat('<p class="section-title">Top 10 Países</p>\n\n')
  
  tabla_top10_data <- datos$top10 %>%
    mutate(
      Pct_Display_Colored = cell_spec(
        Pct_Display,
        "html",
        color = Pct_Color,
        bold = TRUE
      )
    ) %>%
    select(`#` = Ranking, País, Valor, `% vs Media` = Pct_Display_Colored)
  
  n_filas <- nrow(tabla_top10_data)
  
  tabla_top10 <- tabla_top10_data %>%
    kbl(
      align = c('c', 'l', 'r', 'c'),
      escape = FALSE
    ) %>%
    kable_styling(
      bootstrap_options = c("striped", "hover"),
      full_width = TRUE,
      font_size = 13
    ) %>%
    row_spec(0, background = "#990000", color = "#FFFFFF", bold = TRUE, font_size = 13) %>%
    row_spec(seq_len(n_filas), background = "#FFFFFF", color = "#2C2C2C") %>%
    column_spec(1, width = "3em", bold = TRUE, color = "#990000", background = "#FFE5E5") %>%
    column_spec(2, width = "13em", bold = TRUE, color = "#2C2C2C") %>%
    column_spec(3, width = "9em", color = "#CC0000", bold = TRUE)
  
  print(tabla_top10)
  cat('\n\n</div>\n\n')
  
  cat('</div>\n\n')

  # Conclusión de la variable
  if (exists("conclusiones_calidad") && !is.null(conclusiones_calidad[[variable]])) {
    cat('\n\n::: conclusion\n', conclusiones_calidad[[variable]], '\n:::\n\n', sep = '')
  }
}

Esperanza vida

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	72,53
Mediana	73,50
Desv. Est.	7,95
Q1	67,43
Q3	77,59
Mínimo	18,82
Máximo	85,75

Top 10 Países

#	País	Valor	% vs Media
1	Monaco	85,75	+18.2%
2	San Marino	85,71	+18.2%
3	Liechtenstein	84,12	+16.0%
4	Andorra	84,02	+15.8%
5	Japan	84,00	+15.8%
6	Switzerland	83,60	+15.3%
7	Australia	83,20	+14.7%
8	Spain	83,13	+14.6%
9	Sweden	83,06	+14.5%
10	Luxembourg	82,95	+14.4%

Conclusión. La esperanza de vida es la variable más homogénea de la base y la que mejor resume el resultado sanitario de cada país.

Centro: la media es de 72,5 años y la mediana de 73,5; la mitad central de los países está entre 67,4 y 77,6 años.
Dispersión: el coeficiente de variación es de solo 11 %, el más bajo de las 15 variables.
Extremos: el top 10 lo forman 8 países europeos, más Japón y Australia, todos entre 14 % y 18 % por encima de la media. En el otro extremo están Lesoto, Chad, Nigeria y Somalia, con menos de 57 años, y la República Centroafricana, con 18,8 años, un valor atípico.
Datos completos: no hubo valores faltantes en esta variable.

Mortalidad infantil

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	26,87
Mediana	15,10
Desv. Est.	38,69
Q1	6,30
Q3	36,60
Mínimo	1,40
Máximo	424,60

Top 10 Países

#	País	Valor	% vs Media
1	Central African Republic	424,60	+1480.0%
2	Somalia, Fed. Rep.	143,10	+432.5%
3	Nigeria	117,50	+337.2%
4	Niger	116,00	+331.6%
5	Chad	103,90	+286.6%
6	Guinea	97,60	+263.2%
7	Sierra Leone	97,10	+261.3%
8	South Sudan	96,70	+259.8%
9	Liberia	87,80	+226.7%
10	Burkina Faso	79,80	+196.9%

Conclusión. La mortalidad en menores de 5 años es una de las variables más desiguales: pocos países concentran la mayor parte de las muertes.

Centro: la media (26,9 por mil) casi duplica a la mediana (15,1), señal de una cola larga hacia valores altos; la mitad central de los países está entre 6,3 y 36,6 por mil.
Dispersión: el coeficiente de variación es de 144 %, y solo 63 de los 193 países superan la media.
Extremos: los 10 países con mayor mortalidad son de África subsahariana. Somalia (143,1) supera la media en 432 % y la República Centroafricana (424,6) la supera en 1.480 %. El valor más bajo es el de San Marino (1,4).
Datos completados: 4 países no tenían dato y recibieron la mediana.

Mortalidad materna

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	121,36
Mediana	51,50
Desv. Est.	168,61
Q1	15,00
Q3	152,00
Mínimo	1,00
Máximo	1.016,00

Top 10 Países

#	País	Valor	% vs Media
1	Nigeria	1.016,00	+737.2%
2	Central African Republic	841,00	+593.0%
3	Chad	775,00	+538.6%
4	South Sudan	704,00	+480.1%
5	Liberia	634,00	+422.4%
6	Somalia, Fed. Rep.	622,00	+412.5%
7	Afghanistan	551,00	+354.0%
8	Benin	547,00	+350.7%
9	Guinea-Bissau	539,00	+344.1%
10	Guinea	500,00	+312.0%

Conclusión. La mortalidad materna presenta la brecha más grande entre países de todas las variables de salud.

Centro: la media (121,4 muertes por cada 100.000 nacidos vivos) es más del doble de la mediana (51,5); la mitad central de los países está entre 15 y 152.
Dispersión: el coeficiente de variación es de 139 %, y solo 59 países superan la media.
Extremos: Nigeria llega a 1.016 muertes, 737 % por encima de la media, mientras que Bielorrusia reporta 1, Polonia y Emiratos Árabes Unidos 2. Nueve de los 10 países con mayor mortalidad materna son de África subsahariana; el décimo es Afganistán.
Datos completados: 5 países no tenían dato y recibieron la mediana.

Gasto salud pc

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	1.329,01
Mediana	445,10
Desv. Est.	2.199,50
Q1	103,90
Q3	1.302,06
Mínimo	15,86
Máximo	12.586,20

Top 10 Países

#	País	Valor	% vs Media
1	United States	12.586,20	+847.0%
2	Switzerland	10.930,14	+722.4%
3	Liechtenstein	10.591,59	+697.0%
4	Norway	8.692,58	+554.1%
5	Monaco	7.674,10	+477.4%
6	Luxembourg	7.022,63	+428.4%
7	Iceland	6.851,63	+415.5%
8	Australia	6.723,98	+405.9%
9	Denmark	6.451,19	+385.4%
10	Ireland	6.407,92	+382.2%

Conclusión. El gasto en salud per cápita es la variable más dispersa de toda la base.

Centro: la media (US$1.329) triplica a la mediana (US$445); la mitad central de los países gasta entre US$104 y US$1.302 por persona.
Dispersión: el coeficiente de variación es de 166 %, el más alto de las 15 variables, y solo 47 países superan la media.
Extremos: Estados Unidos gasta US$12.586 por persona, 847 % por encima de la media y 794 veces lo que gasta Madagascar (US$15,9). El top 10 lo completan 8 países europeos y Australia, todos con más de US$6.400.
Datos completados: 6 países no tenían dato y recibieron la mediana.

Gasto bolsillo

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	30,07
Mediana	27,60
Desv. Est.	18,66
Q1	14,37
Q3	41,59
Mínimo	0,04
Máximo	79,22

Top 10 Países

#	País	Valor	% vs Media
1	Turkmenistan	79,22	+163.5%
2	Armenia	79,09	+163.0%
3	Bangladesh	78,25	+160.2%
4	Afghanistan	77,95	+159.2%
5	Nigeria	75,74	+151.9%
6	Yemen, Rep.	71,38	+137.4%
7	Cameroon	67,75	+125.3%
8	Equatorial Guinea	66,72	+121.9%
9	Guinea-Bissau	66,27	+120.4%
10	Azerbaijan	66,26	+120.4%

Conclusión. El gasto de bolsillo muestra quién paga la atención médica, y su comportamiento es distinto al del resto de indicadores económicos.

Centro: la media (30,1 %) y la mediana (27,6 %) están cerca, así que la distribución es bastante equilibrada; la mitad central de los países está entre 14,4 % y 41,6 %.
Dispersión: el coeficiente de variación es de 62 %.
Extremos: en Turkmenistán (79,2 %), Armenia (79,1 %) y Bangladesh (78,3 %) los hogares pagan casi todo el gasto en salud. El top 10 mezcla países de África subsahariana, Asia del Sur y Asia Central, no solo los más pobres. En Tuvalu, Nauru y Kiribati el gasto de bolsillo es menor al 1 %.
Datos completados: 5 países no tenían dato y recibieron la mediana.

Medicos

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	2,22
Mediana	2,24
Desv. Est.	1,47
Q1	0,79
Q3	2,96
Mínimo	0,03
Máximo	6,60

Top 10 Países

#	País	Valor	% vs Media
1	Seychelles	6,60	+197.7%
2	Greece	6,58	+196.8%
3	Portugal	5,85	+164.0%
4	Georgia	5,54	+149.9%
5	Argentina	5,44	+145.4%
6	Austria	5,43	+145.1%
7	Andorra	5,16	+132.7%
8	Russian Federation	5,11	+130.6%
9	Norway	4,91	+121.5%
10	Uruguay	4,67	+110.9%

Conclusión. La disponibilidad de médicos separa con claridad a los países con sistemas de salud consolidados de los que tienen escasez crítica de personal.

Centro: la media (2,22 médicos por cada 1.000 habitantes) y la mediana (2,24) son casi iguales; la mitad central de los países está entre 0,79 y 2,96.
Extremos: Seychelles (6,60) y Grecia (6,58) duplican la media. El top 10 lo completan países europeos y del Cono Sur (Argentina y Uruguay). Níger y la República Centroafricana tienen solo 0,03 médicos, es decir, 220 veces menos que Seychelles.
Datos completados: 72 países (37 %) no tenían dato y recibieron la mediana. Por eso 72 países comparten exactamente el valor de 2,24, lo que concentra artificialmente la distribución en el centro.

Enfermeria

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	4,53
Mediana	4,04
Desv. Est.	3,23
Q1	2,94
Q3	4,98
Mínimo	0,19
Máximo	18,76

Top 10 Países

#	País	Valor	% vs Media
1	Switzerland	18,76	+314.0%
2	Norway	16,09	+255.1%
3	Iceland	15,64	+245.2%
4	Ireland	14,09	+211.0%
5	Luxembourg	13,71	+202.6%
6	Australia	13,45	+196.8%
7	United States	13,38	+195.3%
8	Japan	12,98	+186.5%
9	Germany	12,25	+170.4%
10	New Zealand	11,86	+161.7%

Conclusión. El personal de enfermería es el recurso humano con mayor diferencia entre los países ricos y el resto.

Centro: la media (4,53 por cada 1.000 habitantes) supera a la mediana (4,04); la mitad central de los países está entre 2,94 y 4,98.
Extremos: Suiza (18,76), Noruega (16,09) e Islandia (15,64) encabezan la lista, con más del triple de la media. El top 10 lo forman solo países de ingreso alto de Europa, Asia-Pacífico y Estados Unidos. Yibuti (0,19) y Chad (0,21) están en el extremo opuesto: Suiza tiene casi 100 veces más personal de enfermería por habitante que Yibuti.
Datos completados: 71 países (37 %) no tenían dato y recibieron la mediana, lo que explica por qué el rango intercuartílico es tan estrecho.

Camas hospital

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	3,09
Mediana	2,83
Desv. Est.	1,69
Q1	2,53
Q3	3,06
Mínimo	0,33
Máximo	12,59

Top 10 Países

#	País	Valor	% vs Media
1	Japan	12,59	+307.3%
2	Belarus	9,93	+221.2%
3	Mongolia	8,75	+183.1%
4	Bulgaria	8,01	+159.1%
5	Germany	7,64	+147.1%
6	Romania	7,23	+133.9%
7	Russian Federation	6,84	+121.3%
8	Austria	6,70	+116.7%
9	Hungary	6,63	+114.5%
10	Czechia	6,54	+111.6%

Conclusión. Las camas de hospital reflejan más el modelo de atención de cada país que su nivel de riqueza.

Centro: la media es de 3,09 camas por cada 1.000 habitantes y la mediana de 2,83.
Extremos: Japón (12,59) tiene el valor más alto, y el resto del top 10 lo forman países de Europa del Este y la antigua Unión Soviética (Bielorrusia, Bulgaria, Rumania, Rusia, Hungría, Chequia), además de Alemania, Austria y Mongolia. Ninguno de los 10 países con mayor gasto per cápita está en este top 10. Togo (0,33) y Afganistán (0,36) tienen la menor capacidad hospitalaria.
Datos completados: es la variable con más datos faltantes: 84 países (43,5 %) recibieron la mediana. Por eso la mitad central de los países queda en un rango muy estrecho (2,53 a 3,06) y sus estadísticas deben leerse con cautela.

Tabaquismo

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	20,42
Mediana	20,20
Desv. Est.	9,21
Q1	12,50
Q3	25,20
Mínimo	3,30
Máximo	48,60

Top 10 Países

#	País	Valor	% vs Media
1	Timor-Leste	48,60	+138.1%
2	Lebanon	45,60	+123.4%
3	Myanmar	44,50	+118.0%
4	Papua New Guinea	40,50	+98.4%
5	Kiribati	39,70	+94.5%
6	North Macedonia	39,60	+94.0%
7	Serbia	39,60	+94.0%
8	Bulgaria	39,10	+91.5%
9	Solomon Islands	38,60	+89.1%
10	Bosnia and Herzegovina	37,60	+84.2%

Conclusión. El tabaquismo no sigue el patrón de pobreza de las demás variables de riesgo.

Centro: la media (20,4 %) y la mediana (20,2 %) son casi iguales, así que la distribución es simétrica; la mitad central de los países está entre 12,5 % y 25,2 % de fumadores.
Extremos: el top 10 está formado por países de Asia-Pacífico (Timor Oriental con 48,6 %, Myanmar, Papúa Nueva Guinea, Kiribati, Islas Salomón), de los Balcanes (Macedonia del Norte, Serbia, Bulgaria, Bosnia y Herzegovina) y Líbano. Los valores más bajos están en Nigeria (3,3 %) y Ghana (3,5 %), dos países africanos.
Datos completados: 32 países no tenían dato y recibieron la mediana.

Desnutricion

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	9,07
Mediana	5,40
Desv. Est.	9,36
Q1	2,50
Q3	11,90
Mínimo	2,50
Máximo	52,80

Top 10 Países

#	País	Valor	% vs Media
1	Somalia, Fed. Rep.	52,80	+482.4%
2	Haiti	51,10	+463.7%
3	Madagascar	39,90	+340.1%
4	Liberia	37,00	+308.2%
5	Zambia	36,20	+299.3%
6	Syrian Arab Republic	35,90	+296.0%
7	Kenya	35,30	+289.4%
8	Chad	30,50	+236.4%
9	Central African Republic	29,60	+226.5%
10	Afghanistan	28,90	+218.8%

Conclusión. La desnutrición se concentra en un grupo reducido de países, en su mayoría afectados por pobreza extrema o conflictos.

Centro: la media (9,1 %) casi duplica a la mediana (5,4 %); la mitad central de los países está entre 2,5 % y 11,9 %.
Piso de los datos: el valor mínimo es 2,5 %, porque el Banco Mundial reporta así a los países con menos de ese porcentaje.
Extremos: en Somalia (52,8 %) y Haití (51,1 %) más de la mitad de la población no consume suficientes alimentos. Siete de los 10 países con mayor desnutrición son de África subsahariana; los otros tres son Haití, Siria y Afganistán.
Datos completados: 35 países no tenían dato y recibieron la mediana.

Sobrepeso

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	52,05
Mediana	55,50
Desv. Est.	16,82
Q1	38,92
Q3	63,76
Mínimo	10,87
Máximo	90,39

Top 10 Países

#	País	Valor	% vs Media
1	Tonga	90,39	+73.7%
2	Nauru	88,84	+70.7%
3	Samoa	87,68	+68.5%
4	Tuvalu	85,77	+64.8%
5	Kiribati	79,14	+52.1%
6	Chile	78,79	+51.4%
7	Kuwait	77,75	+49.4%
8	Qatar	76,60	+47.2%
9	Bahamas, The	75,79	+45.6%
10	St. Kitts and Nevis	75,46	+45.0%

Conclusión. El sobrepeso es un problema mayoritario: afecta a más de la mitad de los adultos en el país típico.

Centro: la mediana es de 55,5 % y la media de 52,0 %; la mitad central de los países está entre 38,9 % y 63,8 %, y 115 países superan la media.
Extremos: las islas del Pacífico encabezan la lista: Tonga (90,4 %), Nauru (88,8 %), Samoa (87,7 %), Tuvalu (85,8 %) y Kiribati (79,1 %). También aparecen Chile, Kuwait, Catar, Bahamas y San Cristóbal y Nieves. Los valores más bajos están en Etiopía (10,9 %), Timor Oriental y Burundi.
Datos completados: 7 países no tenían dato y recibieron la mediana.

Inmunizacion sarampion

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	84,51
Mediana	90,00
Desv. Est.	14,79
Q1	79,00
Q3	96,00
Mínimo	32,00
Máximo	99,00

Top 10 Países

#	País	Valor	% vs Media
1	Antigua and Barbuda	99,00	+17.1%
2	Bahrain	99,00	+17.1%
3	China	99,00	+17.1%
4	Cuba	99,00	+17.1%
5	Fiji	99,00	+17.1%
6	Hungary	99,00	+17.1%
7	Iran, Islamic Rep.	99,00	+17.1%
8	Kazakhstan	99,00	+17.1%
9	Kuwait	99,00	+17.1%
10	Luxembourg	99,00	+17.1%

Conclusión. La vacunación contra el sarampión es alta en la mayoría de los países, pero tiene una cola de países con coberturas peligrosamente bajas.

Centro: la mediana es de 90 % y la media de 84,5 %; la mitad central de los países está entre 79 % y 96 %.
Dispersión: el coeficiente de variación es de 17,5 %, uno de los más bajos, porque la mayoría de los países está cerca del máximo.
Extremos: muchos países empatan en 99 %, el valor más alto, así que el top 10 incluye países de todas las regiones, como China, Cuba, Irán, Kuwait y Hungría. En el otro extremo están la República Centroafricana (32 %), Montenegro (33 %), Papúa Nueva Guinea (41 %) y Madagascar (44 %).
Datos completados: 5 países no tenían dato y recibieron la mediana.

Inmunizacion DPT

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	86,40
Mediana	91,00
Desv. Est.	13,32
Q1	82,00
Q3	96,00
Mínimo	33,00
Máximo	99,00

Top 10 Países

#	País	Valor	% vs Media
1	Antigua and Barbuda	99,00	+14.6%
2	Brunei Darussalam	99,00	+14.6%
3	China	99,00	+14.6%
4	Cuba	99,00	+14.6%
5	Ghana	99,00	+14.6%
6	Hungary	99,00	+14.6%
7	Iran, Islamic Rep.	99,00	+14.6%
8	Japan	99,00	+14.6%
9	Kazakhstan	99,00	+14.6%
10	Luxembourg	99,00	+14.6%

Conclusión. La cobertura de la vacuna DPT es el indicador con mejor desempeño general de toda la base.

Centro: la mediana es de 91 % y la media de 86,4 %; la mitad central de los países está entre 82 % y 96 %.
Dispersión: el coeficiente de variación es de 15,4 %, uno de los más bajos de las 15 variables.
Extremos: el top 10 está formado por países que llegan al 99 %, entre ellos Ghana, China, Cuba y Japón. Que aparezca un país africano de ingreso bajo muestra que la vacunación no depende solo de la riqueza. Las coberturas más bajas están en la República Centroafricana (33 %), Papúa Nueva Guinea (37 %), Venezuela (43 %) y Haití (48 %).
Datos completados: 5 países no tenían dato y recibieron la mediana.

Natalidad

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	18,41
Mediana	16,04
Desv. Est.	9,65
Q1	10,10
Q3	26,34
Mínimo	5,68
Máximo	45,42

Top 10 Países

#	País	Valor	% vs Media
1	Central African Republic	45,42	+146.7%
2	Somalia, Fed. Rep.	43,79	+137.8%
3	Chad	43,35	+135.4%
4	Niger	41,95	+127.8%
5	Mali	40,34	+119.1%
6	Angola	38,10	+106.9%
7	Mozambique	37,99	+106.3%
8	Afghanistan	36,05	+95.7%
9	Uganda	35,80	+94.4%
10	Tanzania	35,64	+93.5%

Conclusión. La natalidad separa con claridad a los países jóvenes de los que están envejeciendo.

Centro: la media es de 18,4 nacimientos por cada 1.000 habitantes y la mediana de 16,0; la mitad central de los países está entre 10,1 y 26,3.
Extremos: nueve de los 10 países con mayor natalidad son de África subsahariana, encabezados por la República Centroafricana (45,4), Somalia (43,8) y Chad (43,4); el décimo es Afganistán. Los valores más bajos están en Ucrania (5,7), San Marino, Japón, Italia y China, todos con menos de 7. La natalidad más alta es 8 veces la más baja.
Datos completos: no hubo valores faltantes en esta variable.

Fertilidad

Estadísticas Globales

Métrica	Valor
Total Países	193
Media	2,47
Mediana	2,00
Desv. Est.	1,21
Q1	1,53
Q3	3,25
Mínimo	0,90
Máximo	6,26

Top 10 Países

#	País	Valor	% vs Media
1	Somalia, Fed. Rep.	6,26	+152.9%
2	Chad	6,22	+151.3%
3	Niger	6,14	+148.1%
4	Central African Republic	6,02	+143.5%
5	Mali	5,69	+130.2%
6	Angola	5,21	+110.6%
7	Burundi	4,98	+101.4%
8	Afghanistan	4,93	+99.4%
9	Mozambique	4,84	+95.7%
10	Mauritania	4,77	+92.9%

Conclusión. La fertilidad confirma la división demográfica que muestra la natalidad.

Centro: la mediana es de 2,0 hijos por mujer, justo por debajo del reemplazo generacional, y la media es de 2,47; la mitad central de los países está entre 1,53 y 3,25.
Extremos: Somalia (6,26), Chad (6,22) y Níger (6,14) encabezan el top 10, formado otra vez por 9 países de África subsahariana y Afganistán. En el otro extremo, Ucrania (0,90), China (1,03), Singapur (1,04), Andorra y Malta tienen menos de 1,1 hijos por mujer.
Lectura: una mujer en Somalia tiene en promedio 7 veces más hijos que una mujer en Ucrania.
Datos completos: no hubo valores faltantes en esta variable.

Solo 193 de los 193 países tienen las 15 variables completas. Las camas de hospital (0,00 % de faltantes), los médicos (0,00 %) y la enfermería (0,00 %) son los que más reducen la base, porque muchos países no reportan estos recursos todos los años. Esto lo tenemos en cuenta más adelante, porque el ACP necesita datos completos.

Conclusión. Las tablas por variable muestran que la base tiene dos tipos de indicadores, según la calidad de sus datos.

Variables completas o casi completas: esperanza de vida, natalidad y fertilidad no tenían vacíos, y las mortalidades, el gasto, el sobrepeso y las vacunas tenían 7 o menos países sin dato.
Variables con muchos vacíos: en la descarga original solo 62 países tenían las 15 variables completas. Camas de hospital (84 países sin dato), médicos (72), enfermería (71), desnutrición (35) y tabaquismo (32) son las variables con más faltantes, y todos esos vacíos se completaron con la mediana.
Consecuencia: en estas cinco variables un grupo grande de países comparte exactamente el mismo valor, lo que reduce su dispersión. Por eso sus medias, rangos intercuartílicos y relaciones con otras variables deben interpretarse con cautela.
Patrón general: en casi todas las variables los extremos negativos se concentran en África subsahariana, y los positivos, en Europa y en los países de ingreso alto de Asia-Pacífico.

3.2 Panorama general de los indicadores

Variable	Países	Media	Mediana	Desv. Est.	Mínimo	Máximo	Asimetría
Tabla 7: Estadísticas descriptivas de los 15 indicadores (2022)
Esperanza vida	193	72,53	73,50	7,95	18,82	85,75	−1,77
Mortalidad infantil	193	26,87	15,10	38,69	1,40	424,60	6,09
Mortalidad materna	193	121,36	51,50	168,61	1,00	1.016,00	2,44
Gasto salud pc	193	1.329,01	445,10	2.199,50	15,86	12.586,20	2,56
Gasto bolsillo	193	30,07	27,60	18,66	0,04	79,22	0,65
Medicos	193	2,22	2,24	1,47	0,03	6,60	0,36
Enfermeria	193	4,53	4,04	3,23	0,19	18,76	1,59
Camas hospital	193	3,09	2,83	1,69	0,33	12,59	1,89
Tabaquismo	193	20,42	20,20	9,21	3,30	48,60	0,47
Desnutricion	193	9,07	5,40	9,36	2,50	52,80	2,08
Sobrepeso	193	52,05	55,50	16,82	10,87	90,39	−0,39
Inmunizacion sarampion	193	84,51	90,00	14,79	32,00	99,00	−1,37
Inmunizacion DPT	193	86,40	91,00	13,32	33,00	99,00	−1,53
Natalidad	193	18,41	16,04	9,65	5,68	45,42	0,73
Fertilidad	193	2,47	2,00	1,21	0,90	6,25	1,06
Fuente: Elaboración propia con base en Banco Mundial (2022).

La tabla muestra que varias variables tienen una media mucho mayor que su mediana, lo que indica que unos pocos países con valores muy altos suben el promedio. El caso más claro es el gasto en salud per cápita: la mediana es de US$445, pero la media llega a US$1.357, y el rango va desde US$15,9 en Madagascar hasta US$12.586 en Estados Unidos, casi 800 veces más. La mortalidad materna (mediana de 51,5 y media de 123,2 muertes por cada 100.000 nacidos vivos) y la mortalidad en menores de 5 años también tienen asimetría positiva alta. En cambio, la esperanza de vida y las coberturas de vacunación tienen asimetría negativa: la mayoría de los países está en valores altos y hay una cola de países rezagados.

Conclusión. La Tabla 7 muestra que los 15 indicadores tienen escalas, dispersiones y formas muy distintas, lo que condiciona cómo debemos analizarlos.

Asimetría positiva fuerte: la mortalidad infantil (6,09), el gasto en salud (2,56), la mortalidad materna (2,44) y la desnutrición (2,08) tienen colas largas hacia valores altos. En estas variables la media exagera la situación del país típico: en el gasto, la media (US$1.329) es tres veces la mediana (US$445).
Asimetría negativa: la esperanza de vida (-1,77), la vacunación DPT (-1,53) y la de sarampión (-1,37) tienen la mayoría de los países en valores altos y una cola de países rezagados.
Variables casi simétricas: médicos (0,36), sobrepeso (-0,39), tabaquismo (0,47) y gasto de bolsillo (0,65) tienen una media y una mediana parecidas.
Dispersión: el gasto en salud (coeficiente de variación de 166 %), la mortalidad infantil (144 %) y la materna (139 %) son las más desiguales; la esperanza de vida (11 %) y las vacunas (15 % a 18 %) son las más homogéneas.
Implicación para el ACP: como las unidades van de porcentajes a miles de dólares, es necesario estandarizar las variables para que ninguna domine solo por su escala.

3.3 Dimensión de longevidad y salud materna/infantil

if (!exists("dinamico")) {
  dinamico <- function(g, alto = 380, tooltip = "all") {
    plotly::ggplotly(g, height = alto, tooltip = tooltip) %>%
      plotly::config(displaylogo = FALSE, responsive = TRUE)
  }
}
histogramas_dimension <- function(variables, titulo, alto = 380) {
  d <- Base_2022 %>%
    select(Pais, all_of(variables)) %>%
    pivot_longer(-Pais, names_to = "Variable", values_to = "Valor") %>%
    filter(!is.na(Valor)) %>%
    mutate(Variable = factor(Variable, levels = variables))

  g <- ggplot(d, aes(Valor)) +
    geom_histogram(bins = 20, fill = "#FF0000", color = "white", linewidth = 0.2) +
    facet_wrap(~ Variable, scales = "free", ncol = min(3, length(variables))) +
    labs(title = titulo, x = NULL, y = "Países") +
    theme_minimal(base_size = 12) +
    theme(plot.title = element_text(face = "bold", color = "#FF0000"),
          strip.text = element_text(face = "bold", color = "#990000"),
          panel.grid.minor = element_blank())

  dinamico(g, alto = alto, tooltip = "all")
}


tablas_dimension <- function(variables) {
  htmltools::tagList(lapply(variables, function(v) {
    res <- crear_tabla_unificada(Base_2022, v)
    htmltools::div(
      style = "display:flex; flex-wrap:wrap; gap:16px; justify-content:center; margin-bottom:24px;",
      htmltools::HTML(gt::as_raw_html(res$tabla_estadisticas, inline_css = FALSE)),
      htmltools::HTML(gt::as_raw_html(res$tabla_top10, inline_css = FALSE))
    )
  }))
}

dim1 <- c("Esperanza vida", "Mortalidad infantil", "Mortalidad materna")
histogramas_dimension(dim1, "Distribución de los indicadores de longevidad y salud materna/infantil")

Conclusión. Los histogramas de esta dimensión muestran dos formas opuestas.

Esperanza de vida: la barra más alta está entre 70 y 75 años, con 51 países. El 10 % de los países con menor esperanza de vida no llega a 63 años y el 10 % con mayor supera los 81,7. La República Centroafricana (18,8 años) aparece aislada a la izquierda.
Mortalidad infantil: 120 países tienen menos de 20 muertes por cada 1.000 nacidos, pero el 10 % con mayor mortalidad supera las 61,6, lo que forma una cola larga hacia la derecha.
Mortalidad materna: 94 países tienen menos de 50 muertes por cada 100.000 nacidos vivos, mientras que el 10 % con mayor mortalidad supera las 355.
Lectura conjunta: la mayoría de los países tiene buenos resultados de longevidad, y un grupo reducido concentra las cifras más graves de mortalidad.

tablas_dimension(dim1[1])

Métrica	Valor
Estadísticas Descriptivas: Esperanza vida
Total Países	193.00
Media	72.53
Mediana	73.50
Desv. Est.	7.95
Q1	67.43
Q3	77.59
Mínimo	18.82
Máximo	85.75

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Esperanza vida
1	Monaco	85.74600	+18.2%
2	San Marino	85.70800	+18.2%
3	Liechtenstein	84.12195	+16.0%
4	Andorra	84.01600	+15.8%
5	Japan	83.99634	+15.8%
6	Switzerland	83.60488	+15.3%
7	Australia	83.20000	+14.7%
8	Spain	83.13415	+14.6%
9	Sweden	83.05854	+14.5%
10	Luxembourg	82.94634	+14.4%

Conclusión. Al aplicar los rangos de la Tabla 1, 94 países (49 %) tienen longevidad intermedia, 55 (28 %) baja longevidad y 44 (23 %) alta longevidad.

Quiénes lideran: 8 de los 10 países con mayor esperanza de vida son europeos, con Mónaco (85,8 años) y San Marino (85,7) a la cabeza; los otros dos son Japón y Australia.
Quiénes están rezagados: los cinco valores más bajos son de África subsahariana: Lesoto, Chad, Nigeria, Somalia y la República Centroafricana.
Tamaño de la brecha: sin contar el valor atípico de la República Centroafricana, la diferencia entre Mónaco y Somalia es de casi 32 años de vida.

tablas_dimension(dim1[2])

Métrica	Valor
Estadísticas Descriptivas: Mortalidad infantil
Total Países	193.00
Media	26.87
Mediana	15.10
Desv. Est.	38.69
Q1	6.30
Q3	36.60
Mínimo	1.40
Máximo	424.60

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Mortalidad infantil
1	Central African Republic	424.6	+1480.2%
2	Somalia, Fed. Rep.	143.1	+432.6%
3	Nigeria	117.5	+337.3%
4	Niger	116.0	+331.7%
5	Chad	103.9	+286.7%
6	Guinea	97.6	+263.2%
7	Sierra Leone	97.1	+261.4%
8	South Sudan	96.7	+259.9%
9	Liberia	87.8	+226.8%
10	Burkina Faso	79.8	+197.0%

Conclusión. Al aplicar los rangos de la Tabla 1, 68 países (35 %) tienen mortalidad infantil baja, 81 (42 %) intermedia y 44 (23 %) alta.

Concentración regional: los 10 países con mayor mortalidad infantil son todos de África subsahariana.
Tamaño de la brecha: Somalia (143,1 por mil) tiene una mortalidad 9,5 veces mayor que la mediana mundial (15,1) y 100 veces mayor que la de San Marino (1,4).
Valor atípico: la República Centroafricana (424,6) casi triplica al segundo país, por lo que distorsiona la media y la escala de los gráficos.

tablas_dimension(dim1[3])

Métrica	Valor
Estadísticas Descriptivas: Mortalidad materna
Total Países	193.00
Media	121.36
Mediana	51.50
Desv. Est.	168.61
Q1	15.00
Q3	152.00
Mínimo	1.00
Máximo	1016.00

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Mortalidad materna
1	Nigeria	1016	+737.2%
2	Central African Republic	841	+593.0%
3	Chad	775	+538.6%
4	South Sudan	704	+480.1%
5	Liberia	634	+422.4%
6	Somalia, Fed. Rep.	622	+412.5%
7	Afghanistan	551	+354.0%
8	Benin	547	+350.7%
9	Guinea-Bissau	539	+344.1%
10	Guinea	500	+312.0%

Conclusión. Al aplicar los rangos de la Tabla 1, 56 países (29 %) tienen mortalidad materna baja, 68 (35 %) moderada y 69 (36 %) alta.

El problema más extendido de la dimensión: es el indicador con más países en el nivel de alerta, por encima de la mortalidad infantil (44 países).
Concentración regional: nueve de los 10 países con mayor mortalidad materna son de África subsahariana, y el décimo es Afganistán.
Tamaño de la brecha: Nigeria (1.016) tiene una mortalidad materna casi 20 veces mayor que la mediana (51,5), mientras que Bielorrusia, Polonia y Emiratos Árabes Unidos reportan 2 o menos.

La mediana de la esperanza de vida es de 73,5 años. Monaco (85,8), San Marino (85,7) y Liechtenstein (84,1) tienen los valores más altos, y en el otro extremo están Somalia (53,9) y Nigeria (54,1). La República Centroafricana aparece con 18,8 años, un valor muy por debajo del resto. Al revisar la serie del Banco Mundial encontramos que este dato cambia mucho de un año a otro (40,3 años en 2021 y 57,4 en 2023), por lo que lo tratamos como un valor atípico.

Las dos mortalidades muestran las brechas más grandes. La mortalidad en menores de 5 años va de 1,4 por mil en San Marino a 117,5 en Nigeria y 143,1 en Somalia, sin contar el valor atípico de la República Centroafricana (424,6). En la mortalidad materna, Bielorrusia reporta 1 muerte por cada 100.000 nacidos vivos, mientras que Nigeria llega a 1.016, Chad a 775 y la República Centroafricana a 841. Al cruzar con la región del Banco Mundial vimos que 41 de los 69 países con mortalidad materna alta (más de 100) y 35 de los 44 países con mortalidad infantil alta (más de 40 por mil) están en África subsahariana.

Conclusión. La dimensión de longevidad y salud materna/infantil separa con claridad a los países de África subsahariana del resto del mundo.

Coherencia entre variables: los países con menor esperanza de vida son los mismos que tienen la mortalidad infantil y materna más alta. En la matriz de correlaciones, la esperanza de vida tiene una correlación de -0,87 con la mortalidad infantil y de -0,82 con la materna.
Brechas: la mortalidad materna es la variable con más países en situación crítica (69), y la mortalidad infantil, la que tiene la cola más extrema.
Qué esperamos del modelo: las tres variables deberían pesar juntas en el primer componente del ACP.

3.4 Dimensión de infraestructura y recursos del sistema de salud

dim2 <- c("Gasto salud pc", "Gasto bolsillo", "Medicos", "Enfermeria", "Camas hospital")
histogramas_dimension(dim2, "Distribución de los indicadores de infraestructura y recursos", alto = 560)

Conclusión. Los histogramas de esta dimensión muestran dos comportamientos: variables muy sesgadas y variables con picos artificiales por los datos completados.

Gasto en salud: 108 países gastan menos de US$500 por persona, mientras que el 10 % que más gasta supera los US$4.700. Es la distribución más sesgada de la dimensión.
Gasto de bolsillo: es la variable más equilibrada: la barra más alta está entre 25 % y 30 %, con 27 países, y los valores se reparten de forma bastante pareja entre 9 % y 57 %.
Médicos, enfermería y camas: cada una tiene un pico muy alto en el centro: 76 países entre 2,0 y 2,5 médicos, 85 entre 4 y 5 en enfermería y 95 entre 2,5 y 3 camas. Ese pico se debe sobre todo a los países que no tenían dato y recibieron la mediana (72, 71 y 84, respectivamente), no a que esos países tengan realmente el mismo nivel de recursos.

tablas_dimension(dim2[1])

Métrica	Valor
Estadísticas Descriptivas: Gasto salud pc
Total Países	193.00
Media	1329.01
Mediana	445.10
Desv. Est.	2199.50
Q1	103.90
Q3	1302.06
Mínimo	15.86
Máximo	12586.20

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Gasto salud pc
1	United States	12586.196	+847.0%
2	Switzerland	10930.140	+722.4%
3	Liechtenstein	10591.593	+697.0%
4	Norway	8692.576	+554.1%
5	Monaco	7674.098	+477.4%
6	Luxembourg	7022.627	+428.4%
7	Iceland	6851.629	+415.5%
8	Australia	6723.982	+405.9%
9	Denmark	6451.194	+385.4%
10	Ireland	6407.923	+382.2%

Conclusión. Al aplicar los rangos de la Tabla 2, 63 países (33 %) tienen baja inversión en salud, 72 (37 %) intermedia y 58 (30 %) alta.

Quiénes lideran: Estados Unidos (US$12.586), Suiza (US$10.930) y Liechtenstein (US$10.592) encabezan el top 10, que completan 7 países europeos de ingreso alto y Australia.
Quiénes están rezagados: Madagascar (US$15,9), Somalia (US$16,3), Burundi, Sudán y Níger gastan menos de US$27 por persona al año.
Tamaño de la brecha: Estados Unidos gasta en salud por persona casi 800 veces lo que gasta Madagascar.

tablas_dimension(dim2[2])

Métrica	Valor
Estadísticas Descriptivas: Gasto bolsillo
Total Países	193.00
Media	30.07
Mediana	27.60
Desv. Est.	18.66
Q1	14.37
Q3	41.59
Mínimo	0.04
Máximo	79.22

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Gasto bolsillo
1	Turkmenistan	79.22116	+163.5%
2	Armenia	79.09084	+163.0%
3	Bangladesh	78.25326	+160.2%
4	Afghanistan	77.94615	+159.2%
5	Nigeria	75.73786	+151.9%
6	Yemen, Rep.	71.37740	+137.4%
7	Cameroon	67.75391	+125.3%
8	Equatorial Guinea	66.71870	+121.9%
9	Guinea-Bissau	66.26608	+120.4%
10	Azerbaijan	66.25884	+120.3%

Conclusión. Al aplicar los rangos de la Tabla 2, 66 países (34 %) tienen alta protección financiera, 73 (38 %) protección moderada y 54 (28 %) alto riesgo.

Dónde pagan más los hogares: en Turkmenistán, Armenia, Bangladesh y Afganistán los hogares pagan más del 77 % del gasto en salud. El top 10 incluye países de ingreso medio de Asia Central y el Cáucaso, no solo los más pobres.
Dónde pagan menos: las islas del Pacífico (Tuvalu, Nauru, Kiribati, Islas Marshall y Micronesia) tienen menos del 3 %, porque el gasto lo cubre casi por completo el Estado o la cooperación internacional.
Lectura: esta variable mide cómo se financia el sistema, no cuánto gasta, por lo que aporta información distinta a la del gasto per cápita.

tablas_dimension(dim2[3])

Métrica	Valor
Estadísticas Descriptivas: Medicos
Total Países	193.00
Media	2.22
Mediana	2.24
Desv. Est.	1.47
Q1	0.79
Q3	2.96
Mínimo	0.03
Máximo	6.60

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Medicos
1	Seychelles	6.598	+197.2%
2	Greece	6.576	+196.2%
3	Portugal	5.851	+163.6%
4	Georgia	5.538	+149.5%
5	Argentina	5.437	+144.9%
6	Austria	5.432	+144.7%
7	Andorra	5.157	+132.3%
8	Russian Federation	5.111	+130.2%
9	Norway	4.908	+121.1%
10	Uruguay	4.674	+110.5%

Conclusión. Al aplicar los rangos de la Tabla 2, 51 países (26 %) tienen déficit de médicos, 94 (49 %) cobertura intermedia y 48 (25 %) alta densidad.

Cuidado con el nivel intermedio: 72 de los 94 países con cobertura intermedia no tenían dato y recibieron la mediana (2,24), así que ese grupo está inflado.
Quiénes lideran: Seychelles (6,60), Grecia (6,58) y Portugal (5,85); el top 10 incluye también a Georgia, Rusia, Argentina y Uruguay, lo que muestra que la densidad de médicos no depende solo del ingreso.
Quiénes están rezagados: Níger, la República Centroafricana, Sudán del Sur, Malawi y Burundi tienen menos de 0,1 médicos por cada 1.000 habitantes.

tablas_dimension(dim2[4])

Métrica	Valor
Estadísticas Descriptivas: Enfermeria
Total Países	193.00
Media	4.53
Mediana	4.04
Desv. Est.	3.23
Q1	2.94
Q3	4.98
Mínimo	0.19
Máximo	18.76

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Enfermeria
1	Switzerland	18.76	+314.1%
2	Norway	16.09	+255.2%
3	Iceland	15.64	+245.3%
4	Ireland	14.09	+211.0%
5	Luxembourg	13.71	+202.6%
6	Australia	13.45	+196.9%
7	United States	13.38	+195.4%
8	Japan	12.98	+186.5%
9	Germany	12.25	+170.4%
10	New Zealand	11.86	+161.8%

Conclusión. Al aplicar los rangos de la Tabla 2, 45 países (23 %) tienen escasez de personal de enfermería, 105 (54 %) un nivel intermedio y 43 (22 %) alta densidad.

Cuidado con el nivel intermedio: 71 de los países del nivel intermedio no tenían dato y recibieron la mediana (4,04).
Quiénes lideran: el top 10 lo forman solo países de ingreso alto (Suiza, Noruega, Islandia, Irlanda, Luxemburgo, Australia, Estados Unidos, Japón, Alemania y Nueva Zelanda), todos con más de 11,8 por cada 1.000 habitantes.
Quiénes están rezagados: Yibuti (0,19), Myanmar (0,20), Chad (0,21), Níger (0,21) y Madagascar (0,28).

tablas_dimension(dim2[5])

Métrica	Valor
Estadísticas Descriptivas: Camas hospital
Total Países	193.00
Media	3.09
Mediana	2.83
Desv. Est.	1.69
Q1	2.53
Q3	3.06
Mínimo	0.33
Máximo	12.59

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Camas hospital
1	Japan	12.59	+307.4%
2	Belarus	9.93	+221.4%
3	Mongolia	8.75	+183.2%
4	Bulgaria	8.01	+159.2%
5	Germany	7.64	+147.2%
6	Romania	7.23	+134.0%
7	Russian Federation	6.84	+121.4%
8	Austria	6.70	+116.8%
9	Hungary	6.63	+114.6%
10	Czechia	6.54	+111.7%

Conclusión. Al aplicar los rangos de la Tabla 2, 36 países (19 %) tienen una capacidad hospitalaria reducida, 123 (64 %) intermedia y 34 (18 %) alta.

Cuidado con el nivel intermedio: es la variable más afectada por los datos completados: 84 países recibieron la mediana (2,83), lo que explica que casi dos tercios queden en el nivel intermedio.
Quiénes lideran: Japón (12,6) y varios países de Europa del Este y la antigua Unión Soviética (Bielorrusia, Bulgaria, Rumania, Rusia, Hungría y Chequia), donde los sistemas de salud se organizaron alrededor de los hospitales.
Quiénes están rezagados: Togo (0,33), Afganistán (0,36), Timor Oriental (0,39), Guatemala (0,44) y Yemen (0,48).

En esta dimensión están las diferencias más grandes entre países. Además del gasto per cápita, el gasto de bolsillo muestra cuánto pagan directamente los hogares: en Turkmenistán (79,2 %), Armenia (79,1 %) y Bangladesh (78,3 %) casi todo el gasto en salud sale del bolsillo de las familias, mientras que en Tuvalu, Nauru y Kiribati es menor al 1 %, porque el Estado financia casi toda la atención.

En recursos humanos, Níger y la República Centroafricana tienen 0,03 médicos por cada 1.000 habitantes, frente a 6,6 en Seychelles y 6,6 en Grecia. En enfermería, Suiza (18,8), Noruega (16,1) e Islandia (15,6) superan por mucho a Yibuti (0,19) y Chad (0,21). Japón tiene la mayor cantidad de camas de hospital (12,6 por cada 1.000 habitantes), seguido de Bielorrusia (9,9) y Mongolia (8,8). Estas tres variables son las que tienen más datos faltantes, así que sus estadísticas describen a los países que sí reportan.

Conclusión. Los recursos del sistema de salud son la dimensión más desigual entre países y, a la vez, la que tiene los datos menos completos.

Desigualdad: las brechas entre el país con más y el país con menos recursos son enormes: casi 800 veces en gasto per cápita, 220 veces en médicos y casi 100 veces en enfermería.
Calidad de los datos: médicos, enfermería y camas tienen entre 37 % y 44 % de valores completados con la mediana, por lo que su variación real está subestimada.
Dos tipos de información: el gasto, los médicos y la enfermería miden la cantidad de recursos y se concentran en los países de ingreso alto; el gasto de bolsillo y las camas responden más al modelo de organización del sistema.

3.5 Dimensión de medicina preventiva y factores de riesgo

dim3 <- c("Tabaquismo", "Desnutricion", "Sobrepeso", "Inmunizacion sarampion", "Inmunizacion DPT")
histogramas_dimension(dim3, "Distribución de los indicadores de prevención y factores de riesgo", alto = 560)

Conclusión. Los histogramas de esta dimensión muestran que la prevención y los riesgos tienen formas muy distintas.

Vacunas: se concentran en el extremo alto: 52 países tienen entre 95 % y 100 % de cobertura contra el sarampión y 56 en DPT. Sin embargo, el 10 % de los países con menor cobertura está por debajo de 63 % (sarampión) y 69 % (DPT).
Sobrepeso: tiene una distribución amplia, con la barra más alta entre 55 % y 60 % (36 países), y valores que van del 27 % al 71 % entre los deciles extremos.
Desnutrición: 66 países están entre 2 % y 4 %, el piso que reporta el Banco Mundial, y el 10 % con mayor desnutrición supera el 22 %.
Tabaquismo: tiene un pico entre 20 % y 22 % (41 países), en parte por los 32 países que recibieron la mediana (20,2 %).

tablas_dimension(dim3[1])

Métrica	Valor
Estadísticas Descriptivas: Tabaquismo
Total Países	193.00
Media	20.42
Mediana	20.20
Desv. Est.	9.21
Q1	12.50
Q3	25.20
Mínimo	3.30
Máximo	48.60

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Tabaquismo
1	Timor-Leste	48.6	+138.0%
2	Lebanon	45.6	+123.3%
3	Myanmar	44.5	+117.9%
4	Papua New Guinea	40.5	+98.3%
5	Kiribati	39.7	+94.4%
6	North Macedonia	39.6	+93.9%
7	Serbia	39.6	+93.9%
8	Bulgaria	39.1	+91.5%
9	Solomon Islands	38.6	+89.0%
10	Bosnia and Herzegovina	37.6	+84.1%

Conclusión. Al aplicar los rangos de la Tabla 3, 61 países (32 %) tienen baja prevalencia de tabaquismo, 81 (42 %) moderada y 51 (26 %) alta.

Dónde se fuma más: en dos zonas del mundo: el Pacífico y el sudeste asiático (Timor Oriental, Myanmar, Papúa Nueva Guinea, Kiribati e Islas Salomón) y los Balcanes (Macedonia del Norte, Serbia, Bulgaria y Bosnia y Herzegovina).
Dónde se fuma menos: Nigeria (3,3 %), Ghana (3,5 %), Etiopía, Panamá y Turkmenistán, todos por debajo del 6 %.
Lectura: el tabaquismo no se concentra en los países más pobres, por lo que es un riesgo que comparten países de distinto nivel de desarrollo.

tablas_dimension(dim3[2])

Métrica	Valor
Estadísticas Descriptivas: Desnutricion
Total Países	193.00
Media	9.07
Mediana	5.40
Desv. Est.	9.36
Q1	2.50
Q3	11.90
Mínimo	2.50
Máximo	52.80

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Desnutricion
1	Somalia, Fed. Rep.	52.8	+482.1%
2	Haiti	51.1	+463.4%
3	Madagascar	39.9	+339.9%
4	Liberia	37.0	+307.9%
5	Zambia	36.2	+299.1%
6	Syrian Arab Republic	35.9	+295.8%
7	Kenya	35.3	+289.2%
8	Chad	30.5	+236.3%
9	Central African Republic	29.6	+226.4%
10	Afghanistan	28.9	+218.6%

Conclusión. Al aplicar los rangos de la Tabla 3, 58 países (30 %) tienen alta seguridad alimentaria, 82 (42 %) vulnerabilidad moderada y 53 (27 %) desnutrición alta.

Dónde hay más hambre: Somalia (52,8 %) y Haití (51,1 %) superan el 50 %, y les siguen Madagascar, Liberia, Zambia, Siria y Kenia, con más de 35 %.
Patrón: siete de los 10 países con más desnutrición son de África subsahariana; los demás (Haití, Siria y Afganistán) son países afectados por crisis prolongadas.
Cuidado con el piso: los 58 países con alta seguridad alimentaria aparecen todos con 2,5 %, porque el Banco Mundial no distingue valores menores.

tablas_dimension(dim3[3])

Métrica	Valor
Estadísticas Descriptivas: Sobrepeso
Total Países	193.00
Media	52.05
Mediana	55.50
Desv. Est.	16.82
Q1	38.92
Q3	63.76
Mínimo	10.87
Máximo	90.39

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Sobrepeso
1	Tonga	90.39	+73.7%
2	Nauru	88.84	+70.7%
3	Samoa	87.68	+68.5%
4	Tuvalu	85.77	+64.8%
5	Kiribati	79.14	+52.0%
6	Chile	78.79	+51.4%
7	Kuwait	77.75	+49.4%
8	Qatar	76.60	+47.2%
9	Bahamas, The	75.79	+45.6%
10	St. Kitts and Nevis	75.46	+45.0%

Conclusión. Al aplicar los rangos de la Tabla 3, 51 países (26 %) tienen baja prevalencia de sobrepeso, 74 (38 %) intermedia y 68 (35 %) alta.

Dónde es más alto: las islas del Pacífico concentran los valores extremos (Tonga, Nauru, Samoa y Tuvalu superan el 85 %), seguidas por Kiribati, Chile, Kuwait, Catar, Bahamas y San Cristóbal y Nieves.
Dónde es más bajo: Etiopía (10,9 %), Timor Oriental (14,4 %), Burundi, Madagascar y Eritrea, que son también países con desnutrición alta.
Lectura: el sobrepeso afecta tanto a países ricos como de ingreso medio, por lo que no sigue el mismo gradiente que la desnutrición.

tablas_dimension(dim3[4])

Métrica	Valor
Estadísticas Descriptivas: Inmunizacion sarampion
Total Países	193.00
Media	84.51
Mediana	90.00
Desv. Est.	14.79
Q1	79.00
Q3	96.00
Mínimo	32.00
Máximo	99.00

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Inmunizacion sarampion
1	Antigua and Barbuda	99	+17.1%
2	Bahrain	99	+17.1%
3	China	99	+17.1%
4	Cuba	99	+17.1%
5	Fiji	99	+17.1%
6	Hungary	99	+17.1%
7	Iran, Islamic Rep.	99	+17.1%
8	Kazakhstan	99	+17.1%
9	Kuwait	99	+17.1%
10	Luxembourg	99	+17.1%

Conclusión. Al aplicar los rangos de la Tabla 3, 100 países (52 %) tienen alta cobertura contra el sarampión, 43 (22 %) cobertura moderada y 50 (26 %) están en alto riesgo de brotes.

Coberturas máximas: muchos países llegan al 99 %, entre ellos China, Cuba, Irán, Kuwait, Kazajistán y Hungría, de regiones y niveles de ingreso muy distintos.
Coberturas críticas: la República Centroafricana (32 %), Montenegro (33 %), Papúa Nueva Guinea (41 %) y Madagascar (44 %). Que aparezca un país europeo como Montenegro muestra que la baja cobertura no es exclusiva de los países pobres.
Lectura: uno de cada cuatro países está por debajo del 80 %, un nivel insuficiente para frenar la transmisión del sarampión.

tablas_dimension(dim3[5])

Métrica	Valor
Estadísticas Descriptivas: Inmunizacion DPT
Total Países	193.00
Media	86.40
Mediana	91.00
Desv. Est.	13.32
Q1	82.00
Q3	96.00
Mínimo	33.00
Máximo	99.00

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Inmunizacion DPT
1	Antigua and Barbuda	99	+14.6%
2	Brunei Darussalam	99	+14.6%
3	China	99	+14.6%
4	Cuba	99	+14.6%
5	Ghana	99	+14.6%
6	Hungary	99	+14.6%
7	Iran, Islamic Rep.	99	+14.6%
8	Japan	99	+14.6%
9	Kazakhstan	99	+14.6%
10	Luxembourg	99	+14.6%

Conclusión. Al aplicar los rangos de la Tabla 3, 110 países (57 %) tienen un esquema DPT sólido, 38 (20 %) aceptable y 45 (23 %) baja cobertura.

Es el indicador con más países en el nivel favorable de todas las variables de la base.
Coberturas máximas: países como Ghana, China, Cuba, Japón y Kazajistán llegan al 99 %, lo que muestra que un país de ingreso bajo también puede alcanzar coberturas completas.
Coberturas críticas: la República Centroafricana (33 %), Papúa Nueva Guinea (37 %), Venezuela (43 %), Haití (48 %) y Azerbaiyán (51 %).

La vacunación es alta en la mayoría de los países: la mediana es de 90 % para sarampión y 91 % para DPT. Aun así, algunos países están muy por debajo del 80 %, el nivel en que aumenta el riesgo de brotes, como la República Centroafricana (32 % y 33 %), Papúa Nueva Guinea (41 % y 37 %) y Venezuela (43 % en DPT). Las dos coberturas tienen una correlación de 0,90, porque los países suelen aplicar los esquemas de vacunación completos.

En nutrición conviven dos problemas opuestos. La desnutrición supera el 50 % de la población en Somalia (52,8 %) y Haití (51,1 %). El sobrepeso en adultos afecta a más del 85 % en Tonga, Nauru y Samoa, y solo al 10,9 % en Etiopía. La desnutrición tiene un piso de 2,5 % porque el Banco Mundial reporta así a los países con un valor menor a ese porcentaje; por eso 58 países aparecen exactamente en 2,5 %. El tabaquismo tiene una mediana de 20,2 % y llega a 48,6 % en Timor Oriental, 45,6 % en Líbano y 44,5 % en Myanmar.

Conclusión. La dimensión de prevención y riesgo muestra que los países enfrentan problemas de salud distintos según su nivel de desarrollo.

La vacunación es la gran fortaleza: más de la mitad de los países supera el 90 % de cobertura, y algunos países de ingreso bajo alcanzan coberturas máximas.
Dos problemas nutricionales opuestos: la desnutrición es más común en los países que gastan menos en salud (correlación de -0,67 con el gasto en escala logarítmica), y el sobrepeso, en los que gastan más (0,56). Además, 21 países tienen las dos situaciones a la vez, con desnutrición mayor al 10 % y sobrepeso mayor al 40 %, como Bolivia, Guatemala, Ecuador, Honduras y Pakistán. Este fenómeno se conoce como doble carga de la malnutrición.
El tabaquismo va por su lado: se concentra en el Pacífico y los Balcanes, sin relación clara con el nivel de ingreso.

3.6 Dimensión de dinámica demográfica

dim4 <- c("Natalidad", "Fertilidad")
histogramas_dimension(dim4, "Distribución de los indicadores demográficos", alto = 340)

Conclusión. Los dos histogramas tienen la misma forma: la mayoría de los países se concentra en valores bajos y una cola de países mantiene tasas altas.

Natalidad: la barra más alta está entre 8 y 10 nacimientos por cada 1.000 habitantes (35 países). El 10 % de los países con menor natalidad está por debajo de 8,6, y el 10 % con mayor natalidad supera los 33.
Fertilidad: la barra más alta está entre 1,4 y 1,6 hijos por mujer (37 países). La mediana es de 2,0, y el 10 % con mayor fertilidad supera los 4,2 hijos por mujer.
Lectura: la mayoría del mundo ya tiene natalidad y fertilidad bajas; los países con tasas altas forman un grupo más pequeño y bien diferenciado.

tablas_dimension(dim4[1])

Métrica	Valor
Estadísticas Descriptivas: Natalidad
Total Países	193.00
Media	18.41
Mediana	16.04
Desv. Est.	9.65
Q1	10.10
Q3	26.34
Mínimo	5.68
Máximo	45.42

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Natalidad
1	Central African Republic	45.425	+146.7%
2	Somalia, Fed. Rep.	43.789	+137.9%
3	Chad	43.350	+135.5%
4	Niger	41.950	+127.9%
5	Mali	40.345	+119.1%
6	Angola	38.102	+107.0%
7	Mozambique	37.990	+106.4%
8	Afghanistan	36.045	+95.8%
9	Uganda	35.800	+94.5%
10	Tanzania	35.637	+93.6%

Conclusión. Al aplicar los rangos de la Tabla 4, 75 países (39 %) tienen natalidad baja, 65 (34 %) intermedia y 53 (27 %) alta.

Natalidad más alta: nueve de los 10 países con más nacimientos son de África subsahariana, encabezados por la República Centroafricana (45,4), Somalia (43,8) y Chad (43,4); el décimo es Afganistán.
Natalidad más baja: Ucrania (5,7), San Marino (6,1), Japón (6,3), Italia (6,7) y China (6,8).
Lectura: los países con más nacimientos son los mismos que tienen la mortalidad infantil y materna más alta, lo que muestra la relación entre demografía y salud.

tablas_dimension(dim4[2])

Métrica	Valor
Estadísticas Descriptivas: Fertilidad
Total Países	193.00
Media	2.47
Mediana	2.00
Desv. Est.	1.21
Q1	1.53
Q3	3.25
Mínimo	0.90
Máximo	6.26

Ranking	País	Valor	Diferencia vs Media
Top 10 Países: Fertilidad
1	Somalia, Fed. Rep.	6.255	+153.2%
2	Chad	6.215	+151.6%
3	Niger	6.135	+148.4%
4	Central African Republic	6.023	+143.8%
5	Mali	5.692	+130.4%
6	Angola	5.209	+110.9%
7	Burundi	4.980	+101.6%
8	Afghanistan	4.932	+99.7%
9	Mozambique	4.840	+96.0%
10	Mauritania	4.770	+93.1%

Conclusión. Al aplicar los rangos de la Tabla 4, 99 países (51 %) están por debajo del reemplazo generacional, 39 (20 %) están en el nivel de reemplazo y 55 (28 %) tienen alta fecundidad.

Fecundidad más alta: Somalia (6,26), Chad (6,22), Níger (6,14) y la República Centroafricana (6,02) superan los 6 hijos por mujer.
Fecundidad más baja: Ucrania (0,90), China (1,03), Singapur (1,04), Andorra (1,07) y Malta (1,08).
Lectura: más de la mitad de los países ya no tiene suficientes nacimientos para reemplazar a su población, lo que anticipa sistemas de salud con más demanda de atención a personas mayores.

La mediana de la tasa de fertilidad es de 2 hijos por mujer, ligeramente por debajo del nivel de reemplazo generacional (2,1). Somalia (6,3), Chad (6,2) y Níger (6,1) tienen la fertilidad más alta, mientras que Ucrania (0,9), China (1,0) y Singapur (1,0) tienen la más baja. La natalidad y la fertilidad tienen una correlación de 0,98, así que en la práctica miden lo mismo; esto es algo que el ACP debería recoger en un mismo componente.

Conclusión. La dinámica demográfica divide al mundo en dos realidades.

Países que envejecen: más de la mitad tiene menos de 2,1 hijos por mujer, sobre todo en Europa y Asia oriental. Sus sistemas de salud enfrentarán más enfermedades crónicas y más demanda de cuidados para personas mayores.
Países jóvenes: 55 países tienen más de 3 hijos por mujer, casi todos en África subsahariana. Sus sistemas de salud deben priorizar la atención materna, infantil y preventiva.
Para el modelo: natalidad y fertilidad tienen una correlación de 0,98, así que en el ACP aportan casi la misma información.

3.7 Clasificación de los países según los rangos de interpretación

Con los rangos de las tablas 1 a 4 contamos cuántos países hay en cada nivel.

rangos <- tribble(
  ~Variable,                ~c1,  ~c2,  ~Bajo,                          ~Medio,                        ~Alto,
  "Esperanza vida",          68,   78,  "Baja longevidad (<68)",        "Intermedia (68-78)",          "Alta longevidad (>78)",
  "Mortalidad infantil",     10,   40,  "Baja (<10‰)",                  "Intermedia (10-40‰)",         "Alta (>40‰)",
  "Mortalidad materna",      20,  100,  "Baja (<20)",                   "Moderada (20-100)",           "Alta (>100)",
  "Gasto salud pc",         200, 1000,  "Baja inversión (<200)",        "Intermedia (200-1.000)",      "Alta inversión (>1.000)",
  "Gasto bolsillo",          20,   40,  "Alta protección (<20%)",       "Moderada (20-40%)",           "Alto riesgo (>40%)",
  "Medicos",                1.5,    3,  "Déficit (<1,5)",               "Intermedia (1,5-3)",          "Alta densidad (>3)",
  "Enfermeria",             2.5,    6,  "Escasez (<2,5)",               "Intermedia (2,5-6)",          "Alta densidad (>6)",
  "Camas hospital",           2,    4,  "Reducida (<2)",                "Intermedia (2-4)",            "Alta (>4)",
  "Tabaquismo",              15,   25,  "Baja (<15%)",                  "Moderada (15-25%)",           "Alta (>25%)",
  "Desnutricion",           2.5,   10,  "Alta seguridad (≤2,5%)",       "Moderada (2,5-10%)",          "Alta desnutrición (>10%)",
  "Sobrepeso",               40,   60,  "Baja (<40%)",                  "Intermedia (40-60%)",         "Alta (>60%)",
  "Inmunizacion sarampion",  80,   90,  "Alto riesgo (<80%)",           "Moderada (80-90%)",           "Alta cobertura (>90%)",
  "Inmunizacion DPT",        80,   90,  "Baja cobertura (<80%)",        "Aceptable (80-90%)",          "Esquema sólido (>90%)",
  "Natalidad",               12,   25,  "Baja (<12‰)",                  "Intermedia (12-25‰)",         "Alta (>25‰)",
  "Fertilidad",             2.1,    3,  "Subreemplazo (<2,1)",          "Reemplazo (2,1-3)",           "Alta fecundidad (>3)"
)

clasificacion <- rangos %>%
  rowwise() %>%
  mutate(
    x = list(Base_2022[[Variable]][!is.na(Base_2022[[Variable]])]),
    
    n_bajo  = if (Variable == "Desnutricion") sum(x <= c1) else sum(x < c1),
    n_alto  = sum(x >= c2),
    n_total = length(x),
    n_medio = n_total - n_bajo - n_alto
  ) %>%
  ungroup() %>%
  transmute(
    Variable,
    Bajo  = paste0(Bajo, ": ", n_bajo, " (", round(100 * n_bajo / n_total), "%)"),
    Medio = paste0(Medio, ": ", n_medio, " (", round(100 * n_medio / n_total), "%)"),
    Alto  = paste0(Alto, ": ", n_alto, " (", round(100 * n_alto / n_total), "%)"),
    `Países con dato` = n_total
  )

clasificacion %>%
  gt() %>%
  tab_header(title = html("<b>Tabla 8: Número de países en cada rango de interpretación</b>")) %>%
  cols_label(Bajo = "Nivel bajo", Medio = "Nivel intermedio", Alto = "Nivel alto") %>%
  tab_style(style = list(cell_text(weight = "bold", color = "white"), cell_fill(color = "#FF0000")),
            locations = cells_column_labels()) %>%
  tab_style(style = cell_text(weight = "bold", color = "#FF0000"),
            locations = cells_body(columns = Variable)) %>%
  tab_style(style = cell_text(size = "small"),
            locations = cells_body(columns = c(Bajo, Medio, Alto))) %>%
  tab_style(style = cell_text(weight = "bold", color = "#FF0000", size = "large"),
            locations = cells_title(groups = "title")) %>%
  tab_options(table.font.names = c("Times New Roman", "Georgia", "serif"),
              table.width = px(860), table.align = "center", data_row.padding = px(5)) %>%
  tab_source_note(source_note = html("<b>Fuente:</b> Elaboración propia con base en Banco Mundial (2022)."))

Variable	Nivel bajo	Nivel intermedio	Nivel alto	Países con dato
Tabla 8: Número de países en cada rango de interpretación
Esperanza vida	Baja longevidad (<68): 55 (28%)	Intermedia (68-78): 94 (49%)	Alta longevidad (>78): 44 (23%)	193
Mortalidad infantil	Baja (<10‰): 68 (35%)	Intermedia (10-40‰): 81 (42%)	Alta (>40‰): 44 (23%)	193
Mortalidad materna	Baja (<20): 56 (29%)	Moderada (20-100): 68 (35%)	Alta (>100): 69 (36%)	193
Gasto salud pc	Baja inversión (<200): 63 (33%)	Intermedia (200-1.000): 72 (37%)	Alta inversión (>1.000): 58 (30%)	193
Gasto bolsillo	Alta protección (<20%): 66 (34%)	Moderada (20-40%): 73 (38%)	Alto riesgo (>40%): 54 (28%)	193
Medicos	Déficit (<1,5): 51 (26%)	Intermedia (1,5-3): 94 (49%)	Alta densidad (>3): 48 (25%)	193
Enfermeria	Escasez (<2,5): 45 (23%)	Intermedia (2,5-6): 105 (54%)	Alta densidad (>6): 43 (22%)	193
Camas hospital	Reducida (<2): 36 (19%)	Intermedia (2-4): 123 (64%)	Alta (>4): 34 (18%)	193
Tabaquismo	Baja (<15%): 61 (32%)	Moderada (15-25%): 81 (42%)	Alta (>25%): 51 (26%)	193
Desnutricion	Alta seguridad (≤2,5%): 58 (30%)	Moderada (2,5-10%): 82 (42%)	Alta desnutrición (>10%): 53 (27%)	193
Sobrepeso	Baja (<40%): 51 (26%)	Intermedia (40-60%): 74 (38%)	Alta (>60%): 68 (35%)	193
Inmunizacion sarampion	Alto riesgo (<80%): 50 (26%)	Moderada (80-90%): 43 (22%)	Alta cobertura (>90%): 100 (52%)	193
Inmunizacion DPT	Baja cobertura (<80%): 45 (23%)	Aceptable (80-90%): 38 (20%)	Esquema sólido (>90%): 110 (57%)	193
Natalidad	Baja (<12‰): 75 (39%)	Intermedia (12-25‰): 65 (34%)	Alta (>25‰): 53 (27%)	193
Fertilidad	Subreemplazo (<2,1): 99 (51%)	Reemplazo (2,1-3): 39 (20%)	Alta fecundidad (>3): 55 (28%)	193
Fuente: Elaboración propia con base en Banco Mundial (2022).

La clasificación muestra que no hay un solo nivel de desarrollo sanitario. Por ejemplo, 55 países tienen baja longevidad (menos de 68 años) y 44 tienen alta mortalidad infantil (más de 40 por mil). En financiamiento, 54 países tienen un gasto de bolsillo mayor al 40 %, lo que pone a muchas familias en riesgo financiero cuando se enferman. En prevención, 50 países tienen una cobertura de sarampión menor al 80 %, y al mismo tiempo 68 países tienen más del 60 % de sus adultos con sobrepeso. En demografía, 99 países ya están por debajo del nivel de reemplazo generacional, mientras que 55 tienen más de 3 hijos por mujer.

Conclusión. La Tabla 8 permite ver, con los mismos rangos para todas las variables, dónde están las fortalezas y los problemas más extendidos.

Fortalezas: la vacunación DPT (110 países, 57 %) y la de sarampión (100 países, 52 %) son las únicas variables en las que más de la mitad de los países alcanza el nivel favorable.
Problemas más extendidos: la mortalidad materna alta (69 países, 36 %), el sobrepeso alto (68 países, 35 %), la alta fecundidad (55 países, 28 %), el alto riesgo financiero por gasto de bolsillo (54 países, 28 %) y la desnutrición alta (53 países, 27 %).
Variables con nivel intermedio inflado: en camas (64 %), enfermería (54 %) y médicos (49 %) el nivel intermedio es el más grande, en buena parte porque los países sin dato recibieron la mediana, que cae justo en ese rango.
Lectura general: ninguna variable ubica a todos los países en el mismo nivel, y un país puede estar bien en unos indicadores y mal en otros. Por eso es necesario un análisis multivariado como el ACP.

3.8 Relaciones entre los indicadores

mat_cor <- cor(Base_2022[, vars_desc], use = "pairwise.complete.obs")

d_cor <- as.data.frame(as.table(mat_cor)) %>%
  setNames(c("Var1", "Var2", "r")) %>%
  mutate(Var1 = factor(Var1, levels = vars_desc),
         Var2 = factor(Var2, levels = rev(vars_desc)),
         info = paste0(Var1, " y ", Var2, ": ", round(r, 2)))

g_cor <- ggplot(d_cor, aes(Var1, Var2, fill = r, text = info)) +
  geom_tile(color = "white", linewidth = 0.4) +
  scale_fill_gradient2(low = "#1c5cab", mid = "#f0efec", high = "#CC0000",
                       midpoint = 0, limits = c(-1, 1), name = "Correlación") +
  labs(title = "Matriz de correlaciones entre los 15 indicadores", x = NULL, y = NULL) +
  theme_minimal(base_size = 11) +
  theme(plot.title = element_text(face = "bold", color = "#FF0000"),
        axis.text.x = element_text(angle = 45, hjust = 1),
        panel.grid = element_blank())

dinamico(g_cor, alto = 620)

Calculamos cada correlación con los países que tienen dato en ambas variables. Los resultados confirman que muchos indicadores se mueven juntos:

Natalidad y fertilidad tienen una correlación de 0,98, y las dos vacunas, de 0,90.
La esperanza de vida se relaciona negativamente con la mortalidad infantil (-0,87), la mortalidad materna (-0,82) y la natalidad (-0,82).
Los médicos se relacionan negativamente con la natalidad (-0,84) y la desnutrición (-0,72): los países con más médicos suelen tener menos nacimientos y menos hambre.
El tabaquismo y el gasto de bolsillo tienen correlaciones más débiles con las demás variables, casi todas menores a 0,5 en valor absoluto, así que miden aspectos distintos de la salud.

Estas correlaciones tan altas son las que justifican usar el ACP: hay información repetida entre las variables que se puede resumir en pocos componentes.

Conclusión. La matriz de correlaciones muestra que las variables se organizan en un gran bloque de desarrollo sanitario y un grupo de variables más independientes.

Cuántas relaciones fuertes hay: de las 105 parejas de variables, 13 tienen una correlación de al menos 0,7 en valor absoluto, 42 tienen una correlación moderada (entre 0,4 y 0,7) y 16 son prácticamente independientes (menos de 0,2).
Las variables más conectadas: natalidad, esperanza de vida, fertilidad, mortalidad materna y médicos tienen, en promedio, correlaciones de más de 0,5 con las demás variables. Son el centro del bloque de desarrollo.
Las variables más aisladas: camas de hospital, tabaquismo y gasto de bolsillo tienen correlaciones promedio de 0,28 o menos. Las relaciones más débiles de toda la matriz son camas con sobrepeso (0,02), gasto en salud con tabaquismo (0,03) y tabaquismo con vacunación contra el sarampión (0,06).
Qué esperamos del ACP: que el primer componente resuma el bloque de desarrollo y que los siguientes recojan las variables aisladas.

d_gv <- Base_2022 %>%
  filter(!is.na(`Gasto salud pc`), !is.na(`Esperanza vida`)) %>%
  mutate(info = paste0(Pais, "<br>Gasto en salud: US$", format(round(`Gasto salud pc`), big.mark = "."),
                       "<br>Esperanza de vida: ", round(`Esperanza vida`, 1), " años"))

g_gv <- ggplot(d_gv, aes(`Gasto salud pc`, `Esperanza vida`, text = info)) +
  geom_point(color = "#FF0000", size = 2, alpha = 0.7) +
  scale_x_log10(labels = scales::label_dollar()) +
  labs(title = "Más gasto en salud, mayor esperanza de vida",
       x = "Gasto corriente en salud per cápita, US$ (escala logarítmica)",
       y = "Esperanza de vida (años)") +
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(face = "bold", color = "#FF0000"),
        panel.grid.minor = element_blank())

dinamico(g_gv, alto = 480)

El gasto en salud per cápita, en escala logarítmica, tiene una correlación de 0,75 con la esperanza de vida. Si quitamos a la República Centroafricana, la correlación sube a 0,81. Aun así, el gasto no lo explica todo. Algunos países logran una esperanza de vida alta con un gasto moderado: Costa Rica llega a 79,3 años con US$979 por persona, China a 78,2 años con US$755 y Albania a 78,8 años con US$507. Esto sugiere que la eficiencia del sistema de salud también importa, no solo cuánto se gasta.

Conclusión. El gráfico confirma que gastar más en salud se asocia con vivir más, pero también muestra que el gasto no lo explica todo.

Fuerza de la relación: la correlación entre el gasto y la esperanza de vida es de 0,55 en escala original y sube a 0,75 en escala logarítmica, porque el efecto del gasto es mucho mayor en los países que gastan poco. Sin la República Centroafricana llega a 0,81.
Los extremos: los 47 países que gastan menos de US$100 por persona tienen una esperanza de vida mediana de 65,3 años, y los 18 que gastan US$5.000 o más, de 82,0 años.
Países eficientes: Líbano (78,0 años con US$230), Albania (78,8 años con US$507), China (78,2 años con US$755), Maldivas (80,8 años con US$884) y Costa Rica (79,3 años con US$979) superan los 78 años gastando menos de US$1.000 por persona.
Países con menor rendimiento del gasto: Nauru (61,9 años con US$2.264), Tuvalu (66,9 años con US$1.300) y Palau (68,9 años con US$2.078) gastan más de US$1.000 y no llegan a 70 años.
Lectura: estos casos son los más interesantes para estudiar la eficiencia de los sistemas de salud, que es la pregunta central de este trabajo.

3.9 Conclusiones del análisis descriptivo

Con esta revisión llegamos a cinco conclusiones que orientan el resto del trabajo:

Las brechas entre países son enormes. El gasto en salud por persona varía casi 800 veces entre Madagascar y Estados Unidos, y la mortalidad materna va de 1 a más de 1.000 muertes por cada 100.000 nacidos vivos.
Los peores resultados se concentran en una región. La mayoría de los países con mortalidad infantil y materna alta están en África subsahariana.
La salud no se mide con un solo número. Un país puede tener alta cobertura de vacunación y, al mismo tiempo, déficit de médicos o un sobrepeso muy extendido. Además, 21 países enfrentan a la vez desnutrición y sobrepeso.
Muchas variables comparten información. Las correlaciones altas entre longevidad, mortalidad, demografía y recursos justifican reducir la dimensión con el ACP antes de agrupar a los países.
Hay decisiones que tomar antes del modelo. Debemos tratar los datos faltantes de médicos, enfermería y camas, revisar el dato atípico de la República Centroafricana y estandarizar las variables, porque tienen escalas muy distintas.

4 Resultados del Modelo

En esta parte ajustamos el modelo en tres pasos. Primero preparamos los datos con las decisiones que quedaron pendientes en el análisis descriptivo. Luego extraemos los componentes principales con el ACP y, por último, agrupamos a los países con el método de Ward usando los factores estimados.

4.1 Matriz de correlaciones del modelo

X <- Base_2022 %>% select(3:17)
R <- cor(X)

d_R <- as.data.frame(as.table(R)) %>%
  setNames(c("Var1", "Var2", "r")) %>%
  mutate(Var1 = factor(Var1, levels = etiquetas_mod),
         Var2 = factor(Var2, levels = rev(etiquetas_mod)),
         info = paste0(Var1, " y ", Var2, ": ", round(r, 2)))

g_R <- ggplot(d_R, aes(Var1, Var2, fill = r, text = info)) +
  geom_tile(color = "white", linewidth = 0.4) +
  scale_fill_gradient2(low = "#1c5cab", mid = "#f0efec", high = "#CC0000",
                       midpoint = 0, limits = c(-1, 1), name = "Correlación") +
  labs(title = "Matriz de correlaciones de las 15 variables del modelo", x = NULL, y = NULL) +
  tema_t3() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1), panel.grid = element_blank())

dinamico(g_R, alto = 620)

Conclusión. La matriz de correlaciones del modelo resume las relaciones que el ACP va a aprovechar para reducir las 15 variables.

Bloque de desarrollo: esperanza de vida, mortalidad infantil y materna, natalidad, fertilidad, médicos y desnutrición forman un bloque de correlaciones fuertes. Dentro de él, las variables de bienestar (esperanza de vida, médicos) se relacionan negativamente con las de rezago (mortalidades, natalidad, desnutrición).
Bloque de vacunación: las dos vacunas tienen una correlación de 0,90 entre sí y correlaciones moderadas con el resto.
Variables aisladas: camas de hospital, tabaquismo y gasto de bolsillo tienen correlaciones débiles con casi todas las demás, así que el primer componente no las representará bien.
Nota: esta matriz coincide con la de la sección descriptiva, porque se calcula sobre la misma base.

idx <- which(upper.tri(R), arr.ind = TRUE)
pares <- tibble(`Variable 1` = rownames(R)[idx[, 1]],
                `Variable 2` = colnames(R)[idx[, 2]],
                r = R[idx]) %>%
  arrange(desc(abs(r))) %>%
  slice_head(n = 6)

n_altas <- sum(abs(R[upper.tri(R)]) >= 0.7)
n_pares <- length(R[upper.tri(R)])
txt_pares <- paste0(pares$`Variable 1`[1:3], " y ", pares$`Variable 2`[1:3], " (r = ", coma(pares$r[1:3], 2), ")", collapse = "; ")

pares %>%
  tabla_t3("Tabla 11: Las seis parejas de variables más correlacionadas", ancho = 640) %>%
  fmt_number(columns = r, decimals = 2, sep_mark = ".", dec_mark = ",") %>%
  cols_label(r = "Correlación (r)")

Variable 1	Variable 2	Correlación (r)
Tabla 11: Las seis parejas de variables más correlacionadas
Natalidad	Fertilidad	0,98
Inmunizacion sarampion	Inmunizacion DPT	0,90
Esperanza vida	Mortalidad infantil	−0,87
Esperanza vida	Natalidad	−0,82
Esperanza vida	Mortalidad materna	−0,82
Esperanza vida	Fertilidad	−0,80
Fuente: Elaboración propia con base en Banco Mundial (2022).

Calculamos esta matriz con los datos del modelo (con logaritmos y sin vacíos), así que es la que usa el ACP. 13 de las 105 parejas de variables tienen una correlación de al menos 0,7 en valor absoluto. Las más fuertes son: Natalidad y Fertilidad (r = 0,98); Inmunizacion sarampion y Inmunizacion DPT (r = 0,90); Esperanza vida y Mortalidad infantil (r = -0,87). Esa información repetida es justamente lo que el ACP resume.

Conclusión. La Tabla 11 confirma que hay mucha información repetida entre las variables, condición necesaria para que el ACP tenga sentido.

Parejas casi redundantes: natalidad y fertilidad (0,98) y las dos vacunas (0,90) miden prácticamente lo mismo.
La esperanza de vida como eje: cuatro de las seis parejas más correlacionadas incluyen la esperanza de vida, que se relaciona negativamente con la mortalidad infantil (-0,87), la natalidad (-0,82), la mortalidad materna (-0,82) y la fertilidad (-0,80).
Adecuación del ACP: el índice KMO es de 0,81, un nivel meritorio, y la prueba de Bartlett ($\chi^2$ = 2.697,7 con 105 grados de libertad, p < 0,001) rechaza que las variables sean independientes. Ambas pruebas respaldan que el ACP es adecuado.

4.2 Análisis de Componentes Principales

4.2.1 Varianza explicada

# ACP sobre la matriz de correlaciones (variables estandarizadas)
pca <- prcomp(X, center = TRUE, scale. = TRUE)

# El signo de un componente es arbitrario: orientamos PC1 (más esperanza de vida) y PC2 (más vacunación)
if (pca$rotation["Esperanza vida", 1] < 0) {
  pca$rotation[, 1] <- -pca$rotation[, 1]
  pca$x[, 1] <- -pca$x[, 1]
}
if (pca$rotation["Inmunizacion DPT", 2] < 0) {
  pca$rotation[, 2] <- -pca$rotation[, 2]
  pca$x[, 2] <- -pca$x[, 2]
}

val_prop <- pca$sdev^2
prop_var <- val_prop / sum(val_prop)
k_pca <- max(sum(val_prop > 1), 2)   # criterio de Kaiser (valor propio > 1), mínimo 2

tabla_var <- tibble(
  Componente = paste0("PC", seq_along(val_prop)),
  `Valor propio` = val_prop,
  `Varianza explicada (%)` = 100 * prop_var,
  `Varianza acumulada (%)` = 100 * cumsum(prop_var)
) %>%
  slice_head(n = 6)

tabla_var %>%
  tabla_t3("Tabla 13: Valores propios y varianza explicada por componente", ancho = 660) %>%
  fmt_number(columns = `Valor propio`, decimals = 3, sep_mark = ".", dec_mark = ",") %>%
  fmt_number(columns = c(`Varianza explicada (%)`, `Varianza acumulada (%)`), decimals = 1, sep_mark = ".", dec_mark = ",") %>%
  tab_style(style = cell_fill(color = "#FFE5E5"), locations = cells_body(rows = seq_len(k_pca))) %>%
  tab_style(style = cell_text(weight = "bold", color = "#FF0000"), locations = cells_body(columns = Componente))

Componente	Valor propio	Varianza explicada (%)	Varianza acumulada (%)
Tabla 13: Valores propios y varianza explicada por componente
PC1	7,499	50,0	50,0
PC2	1,448	9,7	59,6
PC3	1,236	8,2	67,9
PC4	1,030	6,9	74,7
PC5	0,876	5,8	80,6
PC6	0,665	4,4	85,0
Fuente: Elaboración propia con base en Banco Mundial (2022).

Conclusión. La Tabla 13 muestra que un solo componente concentra la mitad de la información de las 15 variables.

PC1: tiene un valor propio de 7,50, es decir, resume la información de 7,5 variables originales, y explica el 50,0 % de la varianza.
PC2 a PC4: tienen valores propios de 1,45, 1,24 y 1,03, y explican entre los tres el 24,8 % de la varianza (9,7 %, 8,2 % y 6,9 %).
Componentes retenidos: según el criterio de Kaiser (valor propio mayor que 1) se retienen 4 componentes, que explican el 74,7 % de la varianza total.
A partir de PC5: los valores propios caen por debajo de 1 (0,88 y 0,66), así que cada uno aporta menos información que una sola variable original.

d_sed <- tibble(Componente = paste0("PC", seq_along(val_prop)),
                var = 100 * prop_var, acum = 100 * cumsum(prop_var)) %>%
  slice_head(n = 8) %>%
  mutate(Componente = factor(Componente, levels = Componente),
         info = paste0(Componente, "<br>Varianza: ", round(var, 1), " %<br>Acumulada: ", round(acum, 1), " %"))

g_sed <- ggplot(d_sed, aes(Componente, text = info)) +
  geom_col(aes(y = var), fill = "#FF0000", width = 0.65) +
  geom_line(aes(y = var, group = 1), color = "#990000", linewidth = 1) +
  geom_point(aes(y = var), color = "#990000", size = 2.5) +
  labs(title = "Varianza explicada por componente principal",
       x = NULL, y = "% de la varianza total") +
  tema_t3()

dinamico(g_sed, alto = 430)

Siguiendo el criterio de Kaiser (valor propio mayor que 1) retenemos 4 componentes, que explican en conjunto el 74,7 % de la variabilidad total (filas resaltadas de la Tabla 13). El primer componente explica por sí solo el 50,0 % y el segundo el 9,7 %. El tercero tiene un valor propio de 1,24, cerca del umbral pero por debajo, y explica el 8,2 %; lo discutimos al interpretar las cargas.

Conclusión. El gráfico de sedimentación confirma visualmente que la información sanitaria de los países se organiza alrededor de un eje dominante.

El codo: la varianza explicada cae bruscamente del 50,0 % en PC1 al 9,7 % en PC2. Ese cambio de pendiente es el codo del gráfico.
Componentes secundarios: PC2, PC3 y PC4 explican porcentajes parecidos (entre 9,7 % y 6,9 %), así que recogen aspectos más específicos que el primer componente.
Componentes descartados: desde PC5 cada componente aporta menos del 6 % y la curva se aplana, lo que indica que los componentes siguientes recogen sobre todo variaciones menores.
Balance: con 4 componentes conservamos el 74,7 % de la información y reducimos el problema de 15 variables a 4 dimensiones.

4.2.2 Cargas e interpretación de los componentes

La carga de una variable en un componente es la correlación entre ambos: $r_{jm} = v_{jm}\sqrt{\lambda_m}$, donde $v_{jm}$ es el coeficiente de la variable $j$ en el componente $m$ y $\lambda_m$ es su valor propio. Valores cercanos a 1 o a −1 indican que la variable define al componente.

library(gt)
library(dplyr)

# 1. Extracción automática de Loadings y Cos² desde res.pca o acp_resultado
if (exists("res.pca")) {
  pca_var <- factoextra::get_pca_var(res.pca)
  loadings_df <- as.data.frame(pca_var$coord)
  cos2_df <- as.data.frame(pca_var$cos2)
} else if (exists("acp_resultado") && !is.null(acp_resultado$co)) {
  loadings_df <- as.data.frame(acp_resultado$co)
  cos2_df <- as.data.frame(acp_resultado$co^2)
} else {
  # Recalcula el ACP directamente sobre la matriz 'X' si faltan los objetos anteriores
  res_temp <- prcomp(X, center = TRUE, scale. = TRUE)
  pca_var <- factoextra::get_pca_var(res_temp)
  loadings_df <- as.data.frame(pca_var$coord)
  cos2_df <- as.data.frame(pca_var$cos2)
}

# 2. Función generadora de tablas con el estilo rojo académico del proyecto
crear_tabla_contribucion <- function(componente_num, loadings_df, cos2_df, titulo, tabla_num) {
  
  comp_data <- data.frame(
    Variable       = rownames(loadings_df),
    Descripcion    = round(abs(loadings_df[, componente_num]), 4),
    Interpretacion = round(cos2_df[, componente_num], 4)
  )
  
  comp_data <- comp_data[order(comp_data$Descripcion, decreasing = TRUE), ]
  rownames(comp_data) <- NULL
  
  tabla <- comp_data %>%
    gt() %>%
    tab_header(
      title    = md(paste0("**Tabla ", tabla_num, "**")),
      subtitle = titulo
    ) %>%
    cols_label(
      Variable       = md("**Variable**"),
      Descripcion    = md("**Loading (|r|)**"),
      Interpretacion = md("**Cos²**")
    ) %>%
    cols_align(
      align   = "center",
      columns = everything()
    ) %>%
    # Encabezados de columna en rojo principal
    tab_style(
      style = list(
        cell_text(weight = "bold", size = "medium", color = "#FFFFFF"),
        cell_fill(color = "#CC0000")
      ),
      locations = cells_column_labels()
    ) %>%
    # Fondo del cuerpo blanco con texto oscuro
    tab_style(
      style = list(
        cell_fill(color = "#FFFFFF"),
        cell_text(color = "#2C2C2C")
      ),
      locations = cells_body()
    ) %>%
    # Columna de Variable destacada en rojo suave
    tab_style(
      style = list(
        cell_text(weight = "bold", color = "#990000"),
        cell_fill(color = "#FFF5F5"),
        cell_borders(sides = "left", color = "#CC0000", weight = px(2))
      ),
      locations = cells_body(columns = Variable)
    ) %>%
    # Destacado para Loadings fuertes (> 0.3) -> Rojo claro
    tab_style(
      style = list(
        cell_text(color = "#990000", weight = "bold"),
        cell_fill(color = "#FFE5E5")
      ),
      locations = cells_body(
        columns = Descripcion,
        rows    = Descripcion > 0.3
      )
    ) %>%
    # Destacado para Loadings moderados (0.15 - 0.3) -> Amarillo suave
    tab_style(
      style = list(
        cell_text(color = "#856404"),
        cell_fill(color = "#FFF9C4")
      ),
      locations = cells_body(
        columns = Descripcion,
        rows    = Descripcion >= 0.15 & Descripcion <= 0.3
      )
    ) %>%
    # Destacado para Cos² excelente (> 0.7) -> Dorado Univalle
    tab_style(
      style = list(
        cell_text(color = "#7A0000", weight = "bold"),
        cell_fill(color = "#FFE082")
      ),
      locations = cells_body(
        columns = Interpretacion,
        rows    = Interpretacion > 0.7
      )
    ) %>%
    # Formato de títulos
    tab_style(
      style = list(
        cell_text(weight = "bold", color = "#CC0000", size = "large")
      ),
      locations = cells_title(groups = "title")
    ) %>%
    tab_style(
      style = list(
        cell_text(color = "#555555", size = "medium")
      ),
      locations = cells_title(groups = "subtitle")
    ) %>%
    # Opciones de bordes y tipografía
    tab_options(
      table.font.names             = "Source Serif Pro",
      table.width                  = pct(100),
      table.border.top.style       = "none",
      table.border.bottom.style    = "none",
      column_labels.border.top.color    = "#CC0000",
      column_labels.border.bottom.color = "#CC0000",
      table_body.hlines.color      = "#FFE5E5",
      table.background.color       = "#FFFFFF",
      data_row.padding             = px(8),
      heading.border.bottom.color  = "#FFD100",
      heading.border.bottom.width  = px(2)
    ) %>%
    tab_source_note(
      source_note = md("**Fuentes:** Elaboración propia con base en los resultados del ACP (Banco Mundial 2022)")
    ) %>%
    tab_footnote(
      footnote  = "Loading (|r|): Contribución absoluta de la variable al componente. >0.3 = fuerte (rojo claro), 0.15-0.3 = moderada (amarillo)",
      locations = cells_title(groups = "subtitle")
    ) %>%
    tab_footnote(
      footnote  = "Cos²: Calidad de representación. >0.7 = excelente (dorado)",
      locations = cells_body(rows = 1, columns = Interpretacion)
    )
    
  return(tabla)
}

# 3. Porcentajes dinámicos de varianza calculados en tu sesión
v1 <- if (exists("prop_var")) round(100 * prop_var[1], 1) else 50.0
v2 <- if (exists("prop_var")) round(100 * prop_var[2], 1) else 9.7
v3 <- if (exists("prop_var")) round(100 * prop_var[3], 1) else 8.0
v4 <- if (exists("prop_var")) round(100 * prop_var[4], 1) else 7.0

tabla_pc1 <- crear_tabla_contribucion(1, loadings_df, cos2_df, paste0("Contribución de Variables al Componente Principal 1 (", v1, "% de varianza)"), 10)
tabla_pc2 <- crear_tabla_contribucion(2, loadings_df, cos2_df, paste0("Contribución de Variables al Componente Principal 2 (", v2, "% de varianza)"), 11)
tabla_pc3 <- crear_tabla_contribucion(3, loadings_df, cos2_df, paste0("Contribución de Variables al Componente Principal 3 (", v3, "% de varianza)"), 12)
tabla_pc4 <- crear_tabla_contribucion(4, loadings_df, cos2_df, paste0("Contribución de Variables al Componente Principal 4 (", v4, "% de varianza)"), 13)

# Imprimir la primera tabla
tabla_pc1

Variable	Loading (\|r\|)	Cos²
Tabla 10
Contribución de Variables al Componente Principal 1 (50% de varianza)¹
Natalidad	0.9115	0.8308²
Esperanza vida	0.8958	0.8024
Fertilidad	0.8891	0.7905
Mortalidad materna	0.8495	0.7216
Mortalidad infantil	0.8123	0.6598
Medicos	0.7976	0.6362
Desnutricion	0.7343	0.5392
Enfermeria	0.7122	0.5073
Inmunizacion sarampion	0.6831	0.4666
Inmunizacion DPT	0.6610	0.4369
Sobrepeso	0.5953	0.3544
Gasto salud pc	0.5716	0.3268
Gasto bolsillo	0.4345	0.1888
Tabaquismo	0.3446	0.1188
Camas hospital	0.3443	0.1186
¹ Loading (\|r\|): Contribución absoluta de la variable al componente. >0.3 = fuerte (rojo claro), 0.15-0.3 = moderada (amarillo)
² Cos²: Calidad de representación. >0.7 = excelente (dorado)
Fuentes: Elaboración propia con base en los resultados del ACP (Banco Mundial 2022)

Conclusión. La Tabla 10 muestra que el primer componente es un índice general de desarrollo sanitario y demográfico.

Todas las variables participan: las 15 tienen una carga mayor que 0,3, algo que no ocurre en ningún otro componente.
Las variables que lo definen: natalidad (0,911), esperanza de vida (0,896), fertilidad (0,889), mortalidad materna (0,849), mortalidad infantil (0,812) y médicos (0,798).
Calidad de representación: cuatro variables tienen un Cos² mayor que 0,7, es decir, el componente recoge más del 70 % de su información: natalidad (0,83), esperanza de vida (0,80), fertilidad (0,79) y mortalidad materna (0,72).
Dirección: la tabla muestra cargas en valor absoluto. En el componente, la esperanza de vida, los médicos, la enfermería y las vacunas tienen signo positivo, y la natalidad, la fertilidad, las mortalidades y la desnutrición, signo negativo. Por eso un valor alto en PC1 indica un país más desarrollado.
Lo que no recoge bien: camas de hospital (0,344), tabaquismo (0,345) y gasto de bolsillo (0,434), las variables más aisladas en la matriz de correlaciones.

tabla_pc2

Variable	Loading (\|r\|)	Cos²
Tabla 11
Contribución de Variables al Componente Principal 2 (9.7% de varianza)¹
Camas hospital	0.5367	0.2881²
Inmunizacion DPT	0.5192	0.2696
Tabaquismo	0.5075	0.2576
Inmunizacion sarampion	0.4898	0.2399
Enfermeria	0.3606	0.1301
Medicos	0.3511	0.1233
Gasto salud pc	0.2160	0.0467
Mortalidad infantil	0.2146	0.0461
Esperanza vida	0.1134	0.0129
Mortalidad materna	0.1132	0.0128
Natalidad	0.0904	0.0082
Desnutricion	0.0757	0.0057
Sobrepeso	0.0646	0.0042
Gasto bolsillo	0.0449	0.0020
Fertilidad	0.0247	0.0006
¹ Loading (\|r\|): Contribución absoluta de la variable al componente. >0.3 = fuerte (rojo claro), 0.15-0.3 = moderada (amarillo)
² Cos²: Calidad de representación. >0.7 = excelente (dorado)
Fuentes: Elaboración propia con base en los resultados del ACP (Banco Mundial 2022)

Conclusión. La Tabla 11 muestra que el segundo componente recoge diferencias que el nivel de desarrollo no explica.

Las variables que lo definen: camas de hospital (0,537), vacunación DPT (0,519), tabaquismo (0,508) y vacunación contra el sarampión (0,490). Entre las cuatro aportan el 73 % de la construcción del componente.
Dirección: las vacunas tienen signo positivo, y las camas, el tabaquismo, los médicos y la enfermería, signo negativo. Un valor alto en PC2 indica un país con mucha vacunación, pero con pocos recursos hospitalarios y poco tabaquismo.
Calidad de representación: ninguna variable supera un Cos² de 0,3, así que PC2 explica solo una parte de cada variable.
Lectura: distingue a países con un modelo preventivo (alta vacunación y pocos hospitales) de países con un modelo más hospitalario y con más consumo de tabaco.

tabla_pc3

Variable	Loading (\|r\|)	Cos²
Tabla 12
Contribución de Variables al Componente Principal 3 (8.2% de varianza)¹
Gasto salud pc	0.6438	0.4144²
Tabaquismo	0.4561	0.2080
Enfermeria	0.4141	0.1715
Gasto bolsillo	0.3803	0.1446
Sobrepeso	0.3090	0.0955
Mortalidad materna	0.1971	0.0388
Mortalidad infantil	0.1804	0.0325
Desnutricion	0.1709	0.0292
Inmunizacion sarampion	0.1692	0.0286
Inmunizacion DPT	0.1636	0.0268
Fertilidad	0.1506	0.0227
Natalidad	0.1156	0.0134
Camas hospital	0.0709	0.0050
Medicos	0.0688	0.0047
Esperanza vida	0.0017	0.0000
¹ Loading (\|r\|): Contribución absoluta de la variable al componente. >0.3 = fuerte (rojo claro), 0.15-0.3 = moderada (amarillo)
² Cos²: Calidad de representación. >0.7 = excelente (dorado)
Fuentes: Elaboración propia con base en los resultados del ACP (Banco Mundial 2022)

Conclusión. La Tabla 12 muestra que el tercer componente se relaciona con cómo se financia la salud y con algunos factores de riesgo.

La variable que lo define: el gasto en salud per cápita (0,644), que por sí solo aporta el 34 % del componente. Le siguen el tabaquismo (0,456), la enfermería (0,414), el gasto de bolsillo (0,380) y el sobrepeso (0,309).
Dirección: el gasto per cápita y la enfermería tienen signo negativo, y el tabaquismo, el gasto de bolsillo y el sobrepeso, signo positivo. Un valor alto en PC3 indica un país con poco gasto total en salud, en el que los hogares pagan una parte grande y hay más tabaquismo.
Ejemplos: los valores más altos los tienen Myanmar, Líbano, Macedonia del Norte, Azerbaiyán y Georgia, y los más bajos Suiza, Estados Unidos, Noruega, Islandia y Japón.
Calidad de representación: el Cos² más alto es el del gasto en salud (0,41), así que es un componente secundario que complementa a PC1.

library(plotly)
library(dplyr)

# 1. Extracción segura de datos
if (!exists("var_data")) {
  if (exists("res.pca")) {
    var_data <- factoextra::get_pca_var(res.pca)
  } else if (exists("acp_resultado") && !is.null(acp_resultado$co)) {
    var_data <- list(
      coord   = as.matrix(acp_resultado$co),
      contrib = as.matrix(acp_resultado$co^2 * 100),
      cos2    = as.matrix(acp_resultado$co^2)
    )
  } else {
    res_temp <- prcomp(X, center = TRUE, scale. = TRUE)
    var_data <- factoextra::get_pca_var(res_temp)
  }
}

# 2. Data Frame para Plotly
var_df <- data.frame(
  Variable = rownames(var_data$coord),
  Dim1     = var_data$coord[, 1],
  Dim2     = var_data$coord[, 2],
  Contrib1 = var_data$contrib[, 1],
  Contrib2 = var_data$contrib[, 2],
  Cos2_1   = var_data$cos2[, 1],
  Cos2_2   = var_data$cos2[, 2]
)

# 3. Escala de colores integrada con la paleta roja del proyecto
red_color_scale <- c("#FF9999", "#CC0000", "#660000")

# 4. Gráfico interactivo estilo rojo académico (Limpio y legible)
p1 <- plot_ly(
  var_df,
  x = ~Dim1,
  y = ~Dim2,
  color = ~Contrib1,
  colors = red_color_scale,
  text = ~paste(
    "<b style='color:#CC0000; font-size:14px;'>", Variable, "</b><br>",
    "<span style='color:#666666;'>COORDENADAS PCA:</span><br>",
    "├─ Dim 1: <b style='color:#CC0000;'>", round(Dim1, 3), "</b><br>",
    "├─ Dim 2: <b style='color:#990000;'>", round(Dim2, 3), "</b><br>",
    "<br><span style='color:#666666;'>CONTRIBUCIÓN:</span><br>",
    "├─ Dim 1: <b style='color:#B30000;'>", round(Contrib1, 2), "%</b><br>",
    "├─ Dim 2: <b style='color:#800000;'>", round(Contrib2, 2), "%</b><br>",
    "<br><span style='color:#666666;'>CALIDAD (Cos²):</span><br>",
    "├─ Dim 1: <b style='color:#CC0000;'>", round(Cos2_1, 3), "</b><br>",
    "└─ Dim 2: <b style='color:#990000;'>", round(Cos2_2, 3), "</b>"
  ),
  type = "scatter",
  mode = "markers", # Mantiene únicamente los puntos y limpia el canvas
  marker = list(
    size = 8,
    opacity = 0.9,
    line = list(width = 0.8, color = "#FFFFFF"),
    symbol = 'circle'
  ),
  hovertemplate = '%{text}<extra></extra>'
) %>%
  add_segments(
    x = 0, xend = ~Dim1, y = 0, yend = ~Dim2,
    line = list(color = "rgba(204, 0, 0, 0.6)", width = 1.3),
    showlegend = FALSE, hoverinfo = "skip"
  ) %>%
  layout(
    title = list(
      text = "<b style='color:#CC0000; font-size:19px;'>Figura 12: Variables-Dimensión 1 vs Dimensión 2</b><br><span style='color:#666666; font-size:13px;'>Coloreado por Contribución a Dimensión 1</span>",
      x = 0.5,
      xanchor = 'center',
      y = 0.95
    ),
    xaxis = list(
      title = "<b style='color:#2C2C2C; font-size:13px;'>Dimensión 1</b>",
      zeroline = TRUE,
      zerolinecolor = "rgba(204, 0, 0, 0.6)",
      zerolinewidth = 1.8,
      gridcolor = '#F0F0F0',
      showgrid = TRUE,
      range = c(-1.1, 1.1),
      tickfont = list(color = '#555555', size = 11),
      titlefont = list(color = '#2C2C2C', size = 13)
    ),
    yaxis = list(
      title = "<b style='color:#2C2C2C; font-size:13px;'>Dimensión 2</b>",
      zeroline = TRUE,
      zerolinecolor = "rgba(204, 0, 0, 0.6)",
      zerolinewidth = 1.8,
      gridcolor = '#F0F0F0',
      showgrid = TRUE,
      range = c(-1.1, 1.1),
      tickfont = list(color = '#555555', size = 11),
      titlefont = list(color = '#2C2C2C', size = 13)
    ),
    hovermode = "closest",
    plot_bgcolor = '#FFFFFF',
    paper_bgcolor = '#FFFFFF',
    font = list(family = "Source Serif Pro, Arial, sans-serif", color = '#2C2C2C', size = 12),
    margin = list(l = 80, r = 80, b = 80, t = 100),
    hoverlabel = list(
      bgcolor = "rgba(255, 253, 245, 0.98)",
      bordercolor = "#CC0000",
      font = list(color = "#2C2C2C", size = 11, family = "Source Serif Pro, Arial")
    ),
    coloraxis = list(
      colorbar = list(
        title = list(
          text = "<b>Contrib1<br>(%)</b>",
          font = list(size = 11, color = "#2C2C2C")
        ),
        tickfont = list(color = '#555555', size = 10),
        thickness = 18,
        len = 0.75
      )
    ),
    shapes = list(
      list(
        type = "circle",
        x0 = -1, x1 = 1,
        y0 = -1, y1 = 1,
        xref = "x", yref = "y",
        line = list(color = "rgba(204, 0, 0, 0.35)", width = 1.5, dash = "dash")
      )
    ),
    annotations = list(
      list(
        x = 0.5,
        y = -0.12,
        xref = "paper",
        yref = "paper",
        text = "<span style='color:#666666; font-size:11px;'>Pasa el mouse sobre los puntos para ver detalles. Vectores = dirección e importancia de variables.</span>",
        showarrow = FALSE,
        xanchor = "center",
        align = "center"
      )
    )
  ) %>%
  config(
    responsive = TRUE,
    displayModeBar = TRUE,
    displaylogo = FALSE,
    modeBarButtonsToRemove = list('lasso2d', 'select2d')
  )

p1

Conclusión. El gráfico ubica las 15 variables en el plano de los dos primeros componentes y permite ver qué variables van juntas.

Eje horizontal (PC1): a la derecha están la esperanza de vida (0,90), los médicos (0,80), la enfermería (0,71) y las vacunas (0,68 y 0,66); a la izquierda, la natalidad (-0,91), la fertilidad (-0,89), la mortalidad materna (-0,85), la infantil (-0,81) y la desnutrición (-0,73). Es la oposición entre desarrollo y rezago.
Eje vertical (PC2): las vacunas están arriba (0,49 y 0,52), y las camas (-0,54) y el tabaquismo (-0,51) abajo.
Variables que se superponen: natalidad y fertilidad ocupan casi el mismo punto, igual que las dos vacunas, porque miden prácticamente lo mismo.
Color: los tonos más oscuros corresponden a las variables que más aportan a PC1: natalidad (11,1 %), esperanza de vida (10,7 %) y fertilidad (10,5 %).

library(plotly)
library(dplyr)

# 1. Extracción segura de datos
if (!exists("var_data")) {
  if (exists("res.pca")) {
    var_data <- factoextra::get_pca_var(res.pca)
  } else if (exists("acp_resultado") && !is.null(acp_resultado$co)) {
    var_data <- list(
      coord   = as.matrix(acp_resultado$co),
      contrib = as.matrix(acp_resultado$co^2 * 100),
      cos2    = as.matrix(acp_resultado$co^2)
    )
  } else {
    res_temp <- prcomp(X, center = TRUE, scale. = TRUE)
    var_data <- factoextra::get_pca_var(res_temp)
  }
}

# 2. Data Frame para Plotly (Dimensión 2 y Dimensión 3)
var_df <- data.frame(
  Variable = rownames(var_data$coord),
  Dim2     = var_data$coord[, 2],
  Dim3     = var_data$coord[, 3],
  Contrib2 = var_data$contrib[, 2],
  Contrib3 = var_data$contrib[, 3],
  Cos2_2   = var_data$cos2[, 2],
  Cos2_3   = var_data$cos2[, 3]
)

# 3. Escala de colores en la paleta roja del proyecto
red_color_scale <- c("#FF9999", "#CC0000", "#660000")

# 4. Gráfico interactivo Dimensión 2 vs Dimensión 3
p2 <- plot_ly(
  var_df,
  x = ~Dim2,
  y = ~Dim3,
  color = ~Contrib2,
  colors = red_color_scale,
  text = ~paste(
    "<b style='color:#CC0000; font-size:14px;'>", Variable, "</b><br>",
    "<span style='color:#666666;'>COORDENADAS PCA:</span><br>",
    "├─ Dim 2: <b style='color:#CC0000;'>", round(Dim2, 3), "</b><br>",
    "├─ Dim 3: <b style='color:#990000;'>", round(Dim3, 3), "</b><br>",
    "<br><span style='color:#666666;'>CONTRIBUCIÓN:</span><br>",
    "├─ Dim 2: <b style='color:#B30000;'>", round(Contrib2, 2), "%</b><br>",
    "├─ Dim 3: <b style='color:#800000;'>", round(Contrib3, 2), "%</b><br>",
    "<br><span style='color:#666666;'>CALIDAD (Cos²):</span><br>",
    "├─ Dim 2: <b style='color:#CC0000;'>", round(Cos2_2, 3), "</b><br>",
    "└─ Dim 3: <b style='color:#990000;'>", round(Cos2_3, 3), "</b>"
  ),
  type = "scatter",
  mode = "markers",
  marker = list(
    size = 8,
    opacity = 0.9,
    line = list(width = 0.8, color = "#FFFFFF"),
    symbol = 'circle'
  ),
  hovertemplate = '%{text}<extra></extra>'
) %>%
  add_segments(
    x = 0, xend = ~Dim2, y = 0, yend = ~Dim3,
    line = list(color = "rgba(204, 0, 0, 0.6)", width = 1.3),
    showlegend = FALSE, hoverinfo = "skip"
  ) %>%
  layout(
    title = list(
      text = "<b style='color:#CC0000; font-size:19px;'>Figura 13: Variables-Dimensión 2 vs Dimensión 3</b><br><span style='color:#666666; font-size:13px;'>Coloreado por Contribución a Dimensión 2</span>",
      x = 0.5,
      xanchor = 'center',
      y = 0.95
    ),
    xaxis = list(
      title = "<b style='color:#2C2C2C; font-size:13px;'>Dimensión 2</b>",
      zeroline = TRUE,
      zerolinecolor = "rgba(204, 0, 0, 0.6)",
      zerolinewidth = 1.8,
      gridcolor = '#F0F0F0',
      showgrid = TRUE,
      range = c(-1.1, 1.1),
      tickfont = list(color = '#555555', size = 11),
      titlefont = list(color = '#2C2C2C', size = 13)
    ),
    yaxis = list(
      title = "<b style='color:#2C2C2C; font-size:13px;'>Dimensión 3</b>",
      zeroline = TRUE,
      zerolinecolor = "rgba(204, 0, 0, 0.6)",
      zerolinewidth = 1.8,
      gridcolor = '#F0F0F0',
      showgrid = TRUE,
      range = c(-1.1, 1.1),
      tickfont = list(color = '#555555', size = 11),
      titlefont = list(color = '#2C2C2C', size = 13)
    ),
    hovermode = "closest",
    plot_bgcolor = '#FFFFFF',
    paper_bgcolor = '#FFFFFF',
    font = list(family = "Source Serif Pro, Arial, sans-serif", color = '#2C2C2C', size = 12),
    margin = list(l = 80, r = 80, b = 80, t = 100),
    hoverlabel = list(
      bgcolor = "rgba(255, 253, 245, 0.98)",
      bordercolor = "#CC0000",
      font = list(color = "#2C2C2C", size = 11, family = "Source Serif Pro, Arial")
    ),
    coloraxis = list(
      colorbar = list(
        title = list(
          text = "<b>Contrib2<br>(%)</b>",
          font = list(size = 11, color = "#2C2C2C")
        ),
        tickfont = list(color = '#555555', size = 10),
        thickness = 18,
        len = 0.75
      )
    ),
    shapes = list(
      list(
        type = "circle",
        x0 = -1, x1 = 1,
        y0 = -1, y1 = 1,
        xref = "x", yref = "y",
        line = list(color = "rgba(204, 0, 0, 0.35)", width = 1.5, dash = "dash")
      )
    ),
    annotations = list(
      list(
        x = 0.5,
        y = -0.12,
        xref = "paper",
        yref = "paper",
        text = "<span style='color:#666666; font-size:11px;'>Pasa el mouse sobre los puntos para ver detalles. Vectores = dirección e importancia de variables.</span>",
        showarrow = FALSE,
        xanchor = "center",
        align = "center"
      )
    )
  ) %>%
  config(
    responsive = TRUE,
    displayModeBar = TRUE,
    displaylogo = FALSE,
    modeBarButtonsToRemove = list('lasso2d', 'select2d'),
    toImageButtonOptions = list(
      format = "png",
      filename = "pca_variables_dim2_dim3",
      width = 1200,
      height = 800
    )
  )

p2

Conclusión. El gráfico de los componentes 2 y 3 muestra las variables que el primer componente no logra representar.

Eje horizontal (PC2): las vacunas están a la derecha, y las camas, el tabaquismo, los médicos y la enfermería a la izquierda.
Eje vertical (PC3): el gasto en salud per cápita (-0,64) y la enfermería (-0,41) están abajo, y el tabaquismo (0,46), el gasto de bolsillo (0,38) y el sobrepeso (0,31) arriba.
Posición del tabaquismo: aparece arriba a la izquierda, lo que indica que pesa tanto en PC2 como en PC3; es una variable que el primer componente casi no explica.
Color: los tonos más oscuros corresponden a las variables que más aportan a PC2: camas (19,9 %), vacuna DPT (18,6 %), tabaquismo (17,8 %) y sarampión (16,6 %).

library(dplyr)

# 1. Garantizar existencia de n_show
if (!exists("n_show")) {
  n_show <- if (exists("k_pca")) k_pca else if (exists("cargas")) min(4, ncol(cargas)) else 4
}

# 2. Garantizar existencia de cargas
if (!exists("cargas")) {
  if (exists("loadings_df")) {
    cargas <- as.matrix(loadings_df)
  } else if (exists("res.pca")) {
    cargas <- factoextra::get_pca_var(res.pca)$coord
  } else {
    cargas <- factoextra::get_pca_var(prcomp(X, center = TRUE, scale. = TRUE))$coord
  }
}

# 3. Garantizar existencia de val_prop y prop_var
if (!exists("val_prop") || !exists("prop_var")) {
  if (exists("res.pca")) {
    eig_temp <- factoextra::get_eigenvalue(res.pca)
    val_prop <- eig_temp[, 1]
    prop_var <- eig_temp[, 2] / 100
  } else {
    res_temp <- prcomp(X, center = TRUE, scale. = TRUE)
    eig_temp <- factoextra::get_eigenvalue(res_temp)
    val_prop <- eig_temp[, 1]
    prop_var <- eig_temp[, 2] / 100
  }
}

# 4. Garantizar existencia del objeto PCA para las puntuaciones
pca_obj <- if (exists("res.pca")) res.pca else if (exists("pca")) pca else prcomp(X, center = TRUE, scale. = TRUE)

umbral_carga <- 0.5
unir <- function(x) if (length(x) == 0) "ninguna variable" else paste(x, collapse = ", ")

# Loop de interpretación sintética por componente
for (j in seq_len(n_show)) {
  cj  <- cargas[, j]
  pos <- names(sort(cj[cj >= umbral_carga], decreasing = TRUE))
  neg <- names(sort(cj[cj <= -umbral_carga]))
  
  cat(sprintf(
    "- **PC%d** (valor propio %s; %s %% de la varianza). Cargas positivas fuertes (r ≥ 0,5): %s. Cargas negativas fuertes (r ≤ -0,5): %s.\n",
    j, 
    if (exists("coma")) coma(val_prop[j], 2) else round(val_prop[j], 2), 
    if (exists("coma")) coma(100 * prop_var[j], 1) else round(100 * prop_var[j], 1), 
    unir(pos), 
    unir(neg)
  ))
}

PC1 (valor propio 7,50; 50,0 % de la varianza). Cargas positivas fuertes (r ≥ 0,5): Esperanza vida, Medicos, Enfermeria, Inmunizacion sarampion, Inmunizacion DPT, Sobrepeso, Gasto salud pc. Cargas negativas fuertes (r ≤ -0,5): Natalidad, Fertilidad, Mortalidad materna, Mortalidad infantil, Desnutricion.
PC2 (valor propio 1,45; 9,7 % de la varianza). Cargas positivas fuertes (r ≥ 0,5): Inmunizacion DPT. Cargas negativas fuertes (r ≤ -0,5): Camas hospital, Tabaquismo.
PC3 (valor propio 1,24; 8,2 % de la varianza). Cargas positivas fuertes (r ≥ 0,5): ninguna variable. Cargas negativas fuertes (r ≤ -0,5): Gasto salud pc.
PC4 (valor propio 1,03; 6,9 % de la varianza). Cargas positivas fuertes (r ≥ 0,5): ninguna variable. Cargas negativas fuertes (r ≤ -0,5): Camas hospital.

# Extracción de países extremos en PC1 y PC2
o1 <- order(pca_obj$x[, 1], decreasing = TRUE)
o2 <- order(pca_obj$x[, 2], decreasing = TRUE)

pc1_alto <- rownames(pca_obj$x)[o1][1:5]
pc1_bajo <- rev(rownames(pca_obj$x)[o1])[1:5]
pc2_alto <- rownames(pca_obj$x)[o2][1:5]
pc2_bajo <- rev(rownames(pca_obj$x)[o2])[1:5]

PC1: nivel de desarrollo sanitario y transición demográfica. Está orientado de modo que valores altos significan más esperanza de vida. En ese extremo se agrupan también el gasto en salud, los médicos, la enfermería y las camas, mientras que la mortalidad infantil y materna, la desnutrición, la natalidad y la fertilidad quedan con cargas negativas (véase la lista y el mapa de calor de cargas). Es decir, PC1 separa a los países con sistemas de salud más dotados, baja mortalidad y pocos nacimientos de los que tienen alta mortalidad, alta fecundidad y pocos recursos. Los países con mayores puntuaciones son , y los de menores puntuaciones son .

PC2: prevención frente a factores de riesgo. Este componente no mide desarrollo, sino que diferencia a países de nivel parecido: opone la cobertura de vacunación (sarampión y DPT, con carga positiva) al tabaquismo (con carga negativa). Los países con mayor puntuación son , con vacunación alta y poco tabaquismo, y los de menor puntuación son , con menor cobertura de vacunación y más tabaquismo.

PC3 (no retenido). Casi toda su carga está en el gasto de bolsillo, que es el indicador que ya habíamos visto aislado en las correlaciones. Como su valor propio queda por debajo de 1, no lo incluimos en la clusterización, pero comprobamos más adelante si cambia el resultado al incluirlo.

Conclusión. Los componentes principales permiten ordenar a los países en pocas dimensiones fáciles de interpretar.

PC1, desarrollo sanitario: los países con puntuaciones más altas son Suiza (4,57), Noruega (4,29), Estados Unidos (3,89), Alemania (3,86) y Japón (3,69). Los más bajos son la República Centroafricana (-12,33), Chad (-7,62), Nigeria (-7,09), Somalia (-6,75) y Madagascar (-5,53).
PC2, prevención frente a recursos hospitalarios y tabaco: los valores más altos los tienen Ruanda (2,29), Omán (2,13), Marruecos (2,01), Tanzania (1,91) y Ghana (1,90), países con vacunación alta y pocos hospitales. Los más bajos son la República Centroafricana, Papúa Nueva Guinea, Japón, Montenegro y Austria. Japón y Austria están ahí por su gran número de camas, no por baja vacunación.
PC3 y PC4: los dos tienen valores propios mayores que 1 (1,24 y 1,03) y se retienen. PC3 recoge el financiamiento (gasto total frente a gasto de bolsillo y tabaco), y PC4 está dominado por las camas de hospital (-0,61) y las vacunas (-0,42 y -0,43).
Lectura: el primer eje ordena a los países por nivel de desarrollo, y los siguientes muestran diferencias entre países de nivel parecido.

4.3 Clusterización jerárquica de Ward

4.3.1 Dendrograma y número de clusters

Aplicamos el método de Ward (ward.D2) sobre las coordenadas de los países en los 4 componentes retenidos, con distancia euclídea. En este método la pérdida de inercia de cada fusión es proporcional al cuadrado de su altura en el dendrograma. La inercia inter-clase con $k$ grupos es la parte de la inercia total que la partición en $k$ clusters ya explica.

scores <- pca$x[, seq_len(k_pca), drop = FALSE]
d_euc <- dist(scores, method = "euclidean")
hc <- hclust(d_euc, method = "ward.D2")

n_pais <- nrow(scores)
inercia_fus <- hc$height^2 / sum(hc$height^2)    # parte de la inercia total que se pierde en cada fusión

ks <- 2:10
perdida     <- sapply(ks, function(k) inercia_fus[n_pais - k + 1])                  # al pasar de k a k-1 clusters
inter_clase <- sapply(ks, function(k) sum(inercia_fus[(n_pais - k + 1):(n_pais - 1)]))
silueta     <- sapply(ks, function(k) mean(cluster::silhouette(cutree(hc, k = k), d_euc)[, 3]))

# Regla: mayor caída relativa de la pérdida de inercia entre k y k + 1 (k entre 3 y 6)
cand  <- 3:6
razon <- perdida[match(cand, ks)] / perdida[match(cand + 1, ks)]
k_final <- cand[which.max(razon)]   # para fijarlo a mano escriba, por ejemplo: k_final <- 4

plot(hc, labels = FALSE, hang = -1, main = "Dendrograma de Ward sobre los componentes principales",
     xlab = "Países", sub = "", ylab = "Altura")
rect.hclust(hc, k = k_final, border = "#CC0000")

Conclusión. El dendrograma muestra cómo se van uniendo los países en grupos cada vez más grandes, según su parecido en los componentes principales.

Las últimas uniones: las tres fusiones finales ocurren a alturas de 43,7, 25,0 y 14,8. La gran distancia entre esas alturas indica que unir los grupos en esos pasos mezclaría países muy distintos.
El corte elegido: al cortar en 3 grupos (rectángulos rojos) evitamos las dos uniones más costosas y obtenemos clusters de 60, 93 y 40 países.
Lectura: por debajo de una altura de 15, las uniones están mucho más cerca unas de otras, lo que indica subgrupos menos diferenciados.

criterio_k <- tibble(
  `Número de clusters (k)` = ks,
  `Inercia inter-clase (%)` = 100 * inter_clase,
  `Pérdida al pasar de k a k-1 (%)` = 100 * perdida,
  `Silueta media` = silueta
)

criterio_k %>%
  tabla_t3("Tabla 14: Criterios para elegir el número de clusters", ancho = 760) %>%
  fmt_number(columns = c(`Inercia inter-clase (%)`, `Pérdida al pasar de k a k-1 (%)`),
             decimals = 1, sep_mark = ".", dec_mark = ",") %>%
  fmt_number(columns = `Silueta media`, decimals = 3, sep_mark = ".", dec_mark = ",") %>%
  tab_style(style = cell_fill(color = "#FFE5E5"),
            locations = cells_body(rows = `Número de clusters (k)` == k_final))

Número de clusters (k)	Inercia inter-clase (%)	Pérdida al pasar de k a k-1 (%)	Silueta media
Tabla 14: Criterios para elegir el número de clusters
2	44,3	44,3	0,465
3	58,8	14,5	0,316
4	63,9	5,1	0,314
5	68,7	4,9	0,283
6	72,9	4,2	0,288
7	76,2	3,3	0,293
8	79,2	3,1	0,264
9	81,4	2,2	0,240
10	83,0	1,5	0,247
Fuente: Elaboración propia con base en Banco Mundial (2022).

Conclusión. La Tabla 14 respalda la elección de 3 clusters con tres criterios.

Inercia inter-clase: con 2 clusters se explica el 44,3 % de la variación entre países, con 3 el 58,8 % y con 4 el 63,9 %. Pasar de 2 a 3 grupos agrega 14,5 puntos, y pasar de 3 a 4 solo 5,1.
Pérdida al reducir grupos: pasar de 3 a 2 clusters sacrifica el 14,5 % de la inercia, casi tres veces más que pasar de 4 a 3 (5,1 %). Esa es la mayor caída relativa entre 3 y 6 clusters.
Silueta: el valor de 2 clusters es el más alto (0,465), pero ese corte solo separa a los países con peor desempeño del resto. Con 3 clusters la silueta es de 0,316, prácticamente igual a la de 4 (0,314), y a partir de 5 baja.
Lectura: 3 clusters equilibran una buena explicación de la variación con grupos interpretables.

d_k <- tibble(
  k = rep(ks, 2),
  Indicador = rep(c("Pérdida de inercia al pasar de k a k-1 (%)", "Silueta media"), each = length(ks)),
  Valor = c(100 * perdida, silueta)
) %>%
  mutate(info = paste0("k = ", k, "<br>", Indicador, ": ", round(Valor, 2)))

g_k <- ggplot(d_k, aes(k, Valor, text = info)) +
  geom_line(color = "#990000") +
  geom_point(color = "#FF0000", size = 2.5) +
  geom_vline(xintercept = k_final, linetype = "dashed", color = "grey40") +
  scale_x_continuous(breaks = ks) +
  facet_wrap(~ Indicador, scales = "free_y", ncol = 2) +
  labs(title = "Criterios para elegir k (línea punteada: k elegido)", x = "Número de clusters (k)", y = NULL) +
  tema_t3()

dinamico(g_k, alto = 420)

Elegimos k = 3. Pasar de 3 a 2 grupos sacrifica 14,5 % de la inercia total, mientras que pasar de 4 a 3 solo cuesta 5,1 %: es la mayor caída relativa entre k = 3 y k = 6. Con 3 clusters la inercia inter-clase llega al 58,8 % y la silueta media es de 0,316. La silueta de k = 2 es 0,465, más alta, pero ese corte solo separa a los países con peor desempeño del resto y deja juntos a grupos con perfiles distintos.

Conclusión. El gráfico de criterios muestra visualmente por qué 3 es el número adecuado de clusters.

Pérdida de inercia (panel izquierdo): cae del 44,3 % con 2 clusters al 14,5 % con 3 y al 5,1 % con 4. Desde ahí la curva queda casi plana, por debajo del 5 %, lo que indica que agregar más grupos aporta muy poco.
Silueta (panel derecho): baja de 0,465 con 2 clusters a 0,316 con 3 y se mantiene entre 0,28 y 0,31 hasta 7 clusters. Después vuelve a caer.
Calidad de la separación: una silueta de alrededor de 0,3 indica una estructura de grupos moderada. Los países forman más un gradiente continuo que bloques completamente separados, así que los clusters deben leerse como tramos de ese gradiente.

4.3.2 Caracterización de los clusters

# Numeramos los clusters de mayor a menor esperanza de vida media (Cluster 1 = mayor longevidad)
grupo <- cutree(hc, k = k_final)
orden_cl <- tibble(g = as.integer(grupo), ev = Base_2022$`Esperanza vida`) %>%
  group_by(g) %>%
  summarise(ev = mean(ev, na.rm = TRUE), .groups = "drop") %>%
  arrange(desc(ev)) %>%
  mutate(nuevo = row_number())

Base_2022$Cluster <- factor(orden_cl$nuevo[match(as.integer(grupo), orden_cl$g)],
                              levels = seq_len(k_final), labels = paste("Cluster", seq_len(k_final)))
grupo <- setNames(as.integer(Base_2022$Cluster), Base_2022$Pais)   # partición de referencia

etiq_cl <- if (k_final == 3) c("alto desempeño sanitario", "desempeño intermedio", "rezago sanitario") else paste("grupo", seq_len(k_final))
tamanos <- as.integer(table(Base_2022$Cluster))

# Regiones (agrupación al estilo del Banco Mundial, elaboración propia)
regiones <- list(
  "África subsahariana" = c("AGO", "BDI", "BEN", "BFA", "BWA", "CAF", "CMR", "COG", "COM", "CPV", "ERI", "ETH", "GAB", "GHA", "GIN", "GMB", "GNB", "GNQ", "KEN", "LBR", "LSO", "MDG", "MLI", "MOZ", "MRT", "MUS", "MWI", "NAM", "NER", "NGA", "RWA", "SDN", "SEN", "SLE", "SOM", "SSD", "STP", "SWZ", "SYC", "TCD", "TGO", "TZA", "UGA", "ZAF", "ZMB", "ZWE"),
  "Medio Oriente y norte de África" = c("ARE", "BHR", "DJI", "DZA", "EGY", "IRN", "IRQ", "ISR", "JOR", "KWT", "LBN", "LBY", "MAR", "OMN", "PSE", "QAT", "SAU", "SYR", "TUN", "YEM"),
  "Europa y Asia Central" = c("ALB", "AND", "ARM", "AUT", "AZE", "BEL", "BGR", "BIH", "BLR", "CHE", "CYP", "CZE", "DEU", "DNK", "ESP", "EST", "FIN", "FRA", "GBR", "GEO", "GRC", "HRV", "HUN", "IRL", "ISL", "ITA", "KAZ", "KGZ", "LIE", "LTU", "LUX", "LVA", "MCO", "MDA", "MKD", "MLT", "MNE", "NLD", "NOR", "POL", "PRT", "ROU", "RUS", "SMR", "SRB", "SVK", "SVN", "SWE", "TJK", "TKM", "TUR", "UKR", "UZB"),
  "Asia del Sur" = c("AFG", "BGD", "BTN", "IND", "LKA", "MDV", "NPL", "PAK"),
  "Asia Oriental y Pacífico" = c("AUS", "BRN", "CHN", "FJI", "FSM", "IDN", "JPN", "KHM", "KIR", "LAO", "MHL", "MMR", "MNG", "MYS", "NRU", "NZL", "PHL", "PLW", "PNG", "SGP", "SLB", "THA", "TLS", "TON", "TUV", "VNM", "VUT", "WSM"),
  "América Latina y el Caribe" = c("ARG", "ATG", "BHS", "BLZ", "BOL", "BRA", "BRB", "CHL", "COL", "CRI", "CUB", "DMA", "DOM", "ECU", "GRD", "GTM", "GUY", "HND", "HTI", "JAM", "KNA", "LCA", "MAF", "MEX", "NIC", "PAN", "PER", "PRY", "SLV", "SUR", "SXM", "TCA", "TTO", "URY", "VCT", "VEN", "VIR"),
  "Norteamérica" = c("CAN", "USA")
)
reg_tab <- stack(regiones)
Base_2022$Region <- as.character(reg_tab$ind[match(Base_2022$Codigo, reg_tab$values)])
Base_2022$Region[is.na(Base_2022$Region)] <- "Sin clasificar"

# Medianas de cada variable por cluster (unidades originales, solo datos observados)
etq_tabla <- c("Esperanza de vida (años)", "Mortalidad < 5 años (‰)", "Mortalidad materna (por 100.000)",
               "Gasto en salud per cápita (US$)", "Gasto de bolsillo (% del gasto)", "Médicos (por 1.000)",
               "Enfermería y partería (por 1.000)", "Camas de hospital (por 1.000)", "Tabaquismo (%)",
               "Desnutrición (%)", "Sobrepeso en adultos (%)", "Vacunación sarampión (%)", "Vacunación DPT (%)",
               "Natalidad (‰)", "Fertilidad (hijos por mujer)")

tab_med <- Base_2022 %>%
  group_by(Cluster) %>%
  summarise(across(all_of(vars_mod), ~ median(.x, na.rm = TRUE)), .groups = "drop") %>%
  pivot_longer(-Cluster, names_to = "Variable", values_to = "valor") %>%
  pivot_wider(names_from = Cluster, values_from = valor) %>%
  mutate(Variable = etq_tabla[match(Variable, vars_mod)])

ev_cl <- tapply(Base_2022$`Esperanza vida`, Base_2022$Cluster, median, na.rm = TRUE)
mi_cl <- tapply(Base_2022$`Mortalidad infantil`, Base_2022$Cluster, median, na.rm = TRUE)
gs_cl <- tapply(Base_2022$`Gasto salud pc`, Base_2022$Cluster, median, na.rm = TRUE)

tab_med %>%
  tabla_t3("Tabla 15: Mediana de cada variable por cluster (unidades originales)", ancho = 780) %>%
  cols_align(align = "left", columns = Variable) %>%
  fmt_number(columns = -Variable, decimals = 1, sep_mark = ".", dec_mark = ",") %>%
  tab_style(style = cell_text(weight = "bold", color = "#FF0000"), locations = cells_body(columns = Variable))

Variable	Cluster 1	Cluster 2	Cluster 3
Tabla 15: Mediana de cada variable por cluster (unidades originales)
Esperanza de vida (años)	80,7	72,7	63,6
Mortalidad < 5 años (‰)	4,2	17,0	58,4
Mortalidad materna (por 100.000)	10,0	64,0	323,5
Gasto en salud per cápita (US$)	2.515,8	382,8	53,8
Gasto de bolsillo (% del gasto)	18,2	30,7	42,0
Médicos (por 1.000)	3,6	2,2	0,2
Enfermería y partería (por 1.000)	6,5	4,0	1,0
Camas de hospital (por 1.000)	3,4	2,8	2,8
Tabaquismo (%)	22,8	20,2	11,2
Desnutrición (%)	2,5	5,4	20,9
Sobrepeso en adultos (%)	58,7	58,1	30,1
Vacunación sarampión (%)	94,5	88,0	70,0
Vacunación DPT (%)	95,0	91,0	76,5
Natalidad (‰)	9,4	17,0	32,5
Fertilidad (hijos por mujer)	1,5	2,1	4,2
Fuente: Elaboración propia con base en Banco Mundial (2022).

Los 192 países se reparten así: (60), (93), (40). La Tabla 15 muestra la mediana de cada indicador en cada grupo y la Figura siguiente muestra qué tanto se aleja cada grupo del promedio de los países, en desviaciones estándar.

Conclusión. La Tabla 15 muestra que los tres clusters forman un gradiente claro de desarrollo sanitario.

Cluster 1, alto desempeño (60 países): esperanza de vida mediana de 80,7 años, mortalidad infantil de 4,2 por mil, gasto de US$2.516 por persona, 3,6 médicos por cada 1.000 habitantes y 1,5 hijos por mujer.
Cluster 2, desempeño intermedio (93 países): esperanza de vida de 72,7 años, mortalidad infantil de 17 por mil, gasto de US$383 y 2,1 hijos por mujer.
Cluster 3, rezago sanitario (40 países): esperanza de vida de 63,6 años, mortalidad infantil de 58,4 por mil, mortalidad materna de 323,5, gasto de US$54, 0,17 médicos, desnutrición de 20,9 % y 4,2 hijos por mujer.
Tamaño de las brechas: entre el Cluster 1 y el 3 hay 17 años de diferencia en esperanza de vida, 47 veces más gasto per cápita, 32 veces menos mortalidad materna y 21 veces más médicos.
Variables que no siguen el gradiente: el sobrepeso y el tabaquismo son más altos en los clusters 1 y 2 que en el 3. En camas de hospital los clusters 2 y 3 tienen la misma mediana (2,83), que corresponde al valor usado para completar los datos faltantes.

library(dplyr)
library(tidyr)
library(gt)

# 1. Detección automática de la base de datos y de la columna Cluster
if (exists("NuevaBase")) {
  df_stats <- NuevaBase
} else if (exists("Base_modelo")) {
  df_stats <- Base_modelo
} else {
  df_stats <- as.data.frame(X)
}

if (!"Cluster" %in% names(df_stats)) {
  col_cl <- intersect(c("cluster", "grupo", "Grupo", "grupos"), names(df_stats))
  if (length(col_cl) > 0) {
    df_stats$Cluster <- df_stats[[col_cl[1]]]
  } else {
    k_use <- if (exists("k_final")) k_final else 3
    num_tmp <- df_stats %>% select(where(is.numeric))
    hc_tmp <- hclust(dist(scale(num_tmp)), method = "ward.D2")
    df_stats$Cluster <- cutree(hc_tmp, k = k_use)
  }
}

# 2. Diccionario de etiquetas descriptivas (con respaldo para variables de salud/nutrición)
nombres_variables <- c(
  "PIB_per"               = "PIB per cápita (US$)",
  "Poblacion"             = "Población total",
  "Esperanza.vida"        = "Esperanza de vida (años)",
  "Acceso.electricidad"   = "Acceso electricidad (%)",
  "Area.boscosa"          = "Área boscosa (%)",
  "Suscripciones.movil"   = "Suscripciones móviles",
  "Crecimiento.PIB"       = "Crecimiento PIB (%)",
  "Mortalidad.infantil"   = "Mortalidad infantil",
  "Inversion.extranjera"  = "Inversión extranjera (%)",
  "Gasto.salud"           = "Gasto en salud (%)",
  "Gasto.bolsillo"        = "Gasto de bolsillo en salud (%)",
  "Uso.internet"          = "Uso de internet (%)",
  "Importaciones"         = "Importaciones (%)",
  "Exportaciones"         = "Exportaciones (%)",
  "Tierra.cultivable"     = "Tierra cultivable (%)",
  "Crecimiento.poblacion" = "Crecimiento población (%)",
  "Industria"             = "Industria (%)",
  "Remesas"               = "Remesas (%)",
  "Natalidad"             = "Tasa de natalidad",
  "Fertilidad"            = "Tasa de fertilidad",
  "Desnutricion"          = "Prevalencia de desnutrición (%)",
  "Sobrepeso"             = "Prevalencia de sobrepeso (%)",
  "Tabaquismo"            = "Prevalencia de tabaquismo (%)",
  "Camas.hospital"        = "Camas hospitalarias (por 1.000 hab.)",
  "Medicos"               = "Médicos (por 1.000 hab.)"
)

# 3. Cálculo de estadísticas descriptivas por Cluster
estadisticas_clusters <- df_stats %>%
  select(Cluster, where(is.numeric)) %>%
  group_by(Cluster) %>%
  summarise(across(
    everything(),
    list(
      Media   = ~round(mean(., na.rm = TRUE), 2),
      Mediana = ~round(median(., na.rm = TRUE), 2),
      DE      = ~round(sd(., na.rm = TRUE), 2),
      Min     = ~round(min(., na.rm = TRUE), 2),
      Max     = ~round(max(., na.rm = TRUE), 2)
    ),
    .names = "{.col}_{.fn}"
  ), .groups = "drop") %>%
  pivot_longer(
    cols = -Cluster,
    names_to = c("Variable", ".value"),
    names_pattern = "^(.*)_(Media|Mediana|DE|Min|Max)$"
  )

# 4. Construcción de la tabla gt con estilo rojo académico
tabla_estadisticas <- estadisticas_clusters %>%
  mutate(
    Etiqueta_Limpia      = gsub("\\.|_", " ", Variable),
    Variable_Descriptiva = coalesce(unname(nombres_variables[Variable]), Etiqueta_Limpia),
    Cluster              = paste("Cluster", Cluster)
  ) %>%
  select(Cluster, Variable_Descriptiva, Media, Mediana, DE, Min, Max) %>%
  arrange(Cluster, Variable_Descriptiva) %>%
  gt(groupname_col = "Cluster") %>%
  tab_header(
    title    = md("**Tabla 15**"),
    subtitle = "Estadísticas Descriptivas por Cluster | Medias, medianas, desviaciones estándar y rangos"
  ) %>%
  cols_label(
    Variable_Descriptiva = md("**Variable**"),
    Media                = md("**Media**"),
    Mediana              = md("**Mediana**"),
    DE                   = md("**D.E.**"),
    Min                  = md("**Mín**"),
    Max                  = md("**Máx**")
  ) %>%
  cols_align(
    align   = "center",
    columns = c(Media, Mediana, DE, Min, Max)
  ) %>%
  cols_align(
    align   = "left",
    columns = Variable_Descriptiva
  ) %>%
  fmt_number(
    columns  = c(Media, Mediana, DE, Min, Max),
    decimals = 2
  ) %>%
  # Encabezados de columnas en rojo institucional
  tab_style(
    style = list(
      cell_text(weight = "bold", size = "medium", color = "#FFFFFF"),
      cell_fill(color = "#CC0000")
    ),
    locations = cells_column_labels()
  ) %>%
  # Encabezados de grupo (Cluster 1, Cluster 2, ...) visibles y destacados
  tab_style(
    style = list(
      cell_fill(color = "#FFE5E5"),
      cell_text(color = "#990000", weight = "bold", size = "medium"),
      cell_borders(sides = c("top", "bottom"), color = "#CC0000", weight = px(1.5))
    ),
    locations = cells_row_groups()
  ) %>%
  # Cuerpo de la tabla limpio en blanco
  tab_style(
    style = list(
      cell_fill(color = "#FFFFFF"),
      cell_text(color = "#2C2C2C")
    ),
    locations = cells_body()
  ) %>%
  # Columna de Variable destacada en rojo suave
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "#990000"),
      cell_fill(color = "#FFF5F5"),
      cell_borders(sides = "left", color = "#CC0000", weight = px(2))
    ),
    locations = cells_body(columns = Variable_Descriptiva)
  ) %>%
  # Bordes verticales sutiles entre estadísticos
  tab_style(
    style = cell_borders(
      sides  = "right",
      color  = "#FFE5E5",
      weight = px(1)
    ),
    locations = cells_body(columns = c(Variable_Descriptiva, Media, Mediana, DE, Min))
  ) %>%
  # Títulos de la tabla
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "#CC0000", size = "large")
    ),
    locations = cells_title(groups = "title")
  ) %>%
  tab_style(
    style = list(
      cell_text(color = "#555555", size = "medium")
    ),
    locations = cells_title(groups = "subtitle")
  ) %>%
  tab_options(
    table.font.names                  = "Source Serif Pro",
    table.width                       = pct(100),
    table.border.top.style            = "none",
    table.border.bottom.style         = "none",
    column_labels.border.top.style    = "solid",
    column_labels.border.top.color    = "#CC0000",
    column_labels.border.top.width    = px(2),
    column_labels.border.bottom.style = "solid",
    column_labels.border.bottom.color = "#CC0000",
    column_labels.border.bottom.width = px(2),
    table_body.hlines.style           = "solid",
    table_body.hlines.color           = "#FFE5E5",
    table_body.hlines.width           = px(1),
    table.background.color            = "#FFFFFF",
    data_row.padding                  = px(7),
    row_group.padding                 = px(9),
    heading.title.font.size           = 18,
    heading.subtitle.font.size        = 13,
    heading.padding                   = px(10),
    heading.border.bottom.style       = "solid",
    heading.border.bottom.width       = px(2),
    heading.border.bottom.color       = "#FFD100"
  ) %>%
  tab_source_note(
    source_note = md("**Fuente:** Elaboración propia con base en datos del Banco Mundial (2022)")
  )

tabla_estadisticas

Variable	Media	Mediana	D.E.	Mín	Máx
Tabla 15
Estadísticas Descriptivas por Cluster \| Medias, medianas, desviaciones estándar y rangos
Cluster 1
Camas hospital	2.57	2.83	0.80	0.33	4.68
Enfermeria	1.95	1.38	1.59	0.19	6.39
Esperanza vida	64.16	64.86	4.14	53.93	72.79
Gasto bolsillo	36.70	33.84	21.02	4.20	77.95
Gasto salud pc	98.97	57.83	114.54	15.86	570.48
Inmunizacion DPT	76.02	79.00	15.71	37.00	99.00
Inmunizacion sarampion	72.02	74.00	16.05	41.00	99.00
Mortalidad infantil	58.71	51.00	26.49	14.70	143.10
Mortalidad materna	308.14	239.00	201.05	21.00	1,016.00
Médicos (por 1.000 hab.)	0.50	0.19	0.72	0.03	2.24
Prevalencia de desnutrición (%)	19.19	18.40	11.81	5.10	52.80
Prevalencia de sobrepeso (%)	34.48	33.29	12.13	10.87	71.11
Prevalencia de tabaquismo (%)	14.41	11.70	7.57	3.30	40.50
Tasa de fertilidad	4.00	4.02	0.96	2.09	6.26
Tasa de natalidad	30.75	30.94	5.99	15.03	43.79
Cluster 2
Camas hospital	2.61	2.83	1.20	0.39	6.27
Enfermeria	3.99	4.04	1.19	0.20	9.41
Esperanza vida	73.89	74.18	3.99	61.93	81.86
Gasto bolsillo	32.07	30.77	19.18	0.04	79.22
Gasto salud pc	581.13	445.10	523.77	56.62	2,327.20
Inmunizacion DPT	88.59	91.00	10.16	51.00	99.00
Inmunizacion sarampion	87.27	90.00	12.02	33.00	99.00
Mortalidad infantil	16.82	15.10	9.65	2.60	55.90
Mortalidad materna	67.79	50.75	57.32	2.00	317.00
Médicos (por 1.000 hab.)	2.25	2.24	0.62	0.55	5.54
Prevalencia de desnutrición (%)	6.61	5.40	4.30	2.50	22.00
Prevalencia de sobrepeso (%)	60.08	61.99	14.86	14.37	90.39
Prevalencia de tabaquismo (%)	21.71	20.20	9.46	5.30	48.60
Tasa de fertilidad	2.09	1.93	0.67	0.90	3.88
Tasa de natalidad	16.04	15.67	5.67	5.68	28.67
Cluster 3
Camas hospital	4.47	3.48	2.27	1.90	12.59
Enfermeria	8.15	7.04	3.76	3.89	18.76
Esperanza vida	79.54	81.09	3.85	71.55	85.75
Gasto bolsillo	19.56	18.04	8.34	7.65	38.95
Gasto salud pc	3,903.95	3,154.57	2,954.66	394.42	12,586.20
Inmunizacion DPT	93.96	94.00	4.06	84.00	99.00
Inmunizacion sarampion	93.16	95.00	4.61	81.00	99.00
Mortalidad infantil	4.99	3.90	3.42	1.40	16.00
Mortalidad materna	15.01	10.00	15.95	1.00	89.00
Médicos (por 1.000 hab.)	3.91	3.72	1.05	2.24	6.60
Prevalencia de desnutrición (%)	2.87	2.50	0.94	2.50	5.40
Prevalencia de sobrepeso (%)	56.00	57.21	9.11	24.04	72.43
Prevalencia de tabaquismo (%)	24.13	23.60	7.41	10.20	39.60
Tasa de fertilidad	1.54	1.48	0.37	1.04	3.05
Tasa de natalidad	9.73	9.30	2.70	6.10	20.82
Fuente: Elaboración propia con base en datos del Banco Mundial (2022)

Conclusión. Esta tabla muestra la media, la mediana, la desviación estándar y el rango de cada variable dentro de cada grupo.

Atención a la numeración: el código de esta tabla vuelve a agrupar a los países con los datos de Base_modelo (192 países, sin la República Centroafricana), por lo que los grupos tienen 51, 90 y 51 países y están numerados al revés: aquí el Cluster 1 es el de rezago (esperanza de vida media de 64,2 años) y el Cluster 3 el de alto desempeño (79,5 años). Coincide en buena parte con la Tabla 15, pero no exactamente.
Variación dentro de los grupos: el grupo de alto desempeño es el más heterogéneo en gasto: su media es de US$3.904, con una desviación de US$2.955 y un rango que va de US$394 a US$12.586.
Grupo de rezago: concentra la mortalidad materna más alta (media de 308, con un máximo de 1.016), la desnutrición (media de 19,2 %) y la fertilidad (media de 4,0 hijos por mujer).
Lectura: las desviaciones estándar muestran que los grupos no son completamente homogéneos, lo que coincide con la silueta moderada de la clusterización.

library(dplyr)
library(tidyr)
library(stringr)
library(gt)

# 1. Detección automática de la base de datos y de la columna Cluster
if (exists("NuevaBase")) {
  df_comp <- NuevaBase
} else if (exists("df_stats")) {
  df_comp <- df_stats
} else if (exists("Base_modelo")) {
  df_comp <- Base_modelo
} else {
  df_comp <- as.data.frame(X)
}

if (!"Cluster" %in% names(df_comp)) {
  col_cl <- intersect(c("cluster", "grupo", "Grupo", "grupos"), names(df_comp))
  if (length(col_cl) > 0) {
    df_comp$Cluster <- df_comp[[col_cl[1]]]
  } else {
    k_use <- if (exists("k_final")) k_final else 3
    num_tmp <- df_comp %>% select(where(is.numeric))
    hc_tmp <- hclust(dist(scale(num_tmp)), method = "ward.D2")
    df_comp$Cluster <- cutree(hc_tmp, k = k_use)
  }
}

# 2. Diccionario de etiquetas descriptivas (si no está cargado previamente)
if (!exists("nombres_variables")) {
  nombres_variables <- c(
    "PIB_per"               = "PIB per cápita (US$)",
    "Poblacion"             = "Población total",
    "Esperanza.vida"        = "Esperanza de vida (años)",
    "Acceso.electricidad"   = "Acceso electricidad (%)",
    "Area.boscosa"          = "Área boscosa (%)",
    "Suscripciones.movil"   = "Suscripciones móviles",
    "Crecimiento.PIB"       = "Crecimiento PIB (%)",
    "Mortalidad.infantil"   = "Mortalidad infantil",
    "Inversion.extranjera"  = "Inversión extranjera (%)",
    "Gasto.salud"           = "Gasto en salud (%)",
    "Gasto.bolsillo"        = "Gasto de bolsillo en salud (%)",
    "Uso.internet"          = "Uso de internet (%)",
    "Importaciones"         = "Importaciones (%)",
    "Exportaciones"         = "Exportaciones (%)",
    "Tierra.cultivable"     = "Tierra cultivable (%)",
    "Crecimiento.poblacion" = "Crecimiento población (%)",
    "Industria"             = "Industria (%)",
    "Remesas"               = "Remesas (%)",
    "Natalidad"             = "Tasa de natalidad",
    "Fertilidad"            = "Tasa de fertilidad",
    "Desnutricion"          = "Prevalencia de desnutrición (%)",
    "Sobrepeso"             = "Prevalencia de sobrepeso (%)",
    "Tabaquismo"            = "Prevalencia de tabaquismo (%)",
    "Camas.hospital"        = "Camas hospitalarias (por 1.000 hab.)",
    "Medicos"               = "Médicos (por 1.000 hab.)"
  )
}

# 3. Cálculo de medias por Cluster
estadisticas_por_cluster <- df_comp %>%
  select(Cluster, where(is.numeric)) %>%
  group_by(Cluster) %>%
  summarise(across(
    everything(),
    list(Media = ~mean(., na.rm = TRUE)),
    .names = "{.col}_{.fn}"
  ), .groups = "drop")

estadisticas_largas <- estadisticas_por_cluster %>%
  pivot_longer(
    cols = -Cluster,
    names_to = "Variable_Estadistica",
    values_to = "Valor"
  ) %>%
  mutate(
    Estadistica = str_extract(Variable_Estadistica, "[^_]+$"),
    Variable    = str_remove(Variable_Estadistica, "_[^_]+$"),
    Valor       = as.numeric(Valor)
  ) %>%
  select(-Variable_Estadistica)

# 4. Construcción de la Tabla 16 con estilo rojo académico
tabla_estadisticas_mejorada <- estadisticas_largas %>%
  filter(Estadistica == "Media") %>%
  mutate(
    Etiqueta_Limpia      = gsub("\\.|_", " ", Variable),
    Variable_Descriptiva = coalesce(unname(nombres_variables[Variable]), Etiqueta_Limpia),
    Cluster              = paste("Cluster", Cluster),
    Valor                = round(Valor, 2)
  ) %>%
  select(Cluster, Variable_Descriptiva, Valor) %>%
  pivot_wider(
    names_from  = Cluster,
    values_from = Valor
  ) %>%
  arrange(Variable_Descriptiva) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla 16**"),
    subtitle = "Comparación de Clusters - Medias por Variable | Análisis comparativo de indicadores"
  ) %>%
  cols_label(
    Variable_Descriptiva = md("**Variable**")
  ) %>%
  cols_align(
    align   = "center",
    columns = -Variable_Descriptiva
  ) %>%
  cols_align(
    align   = "left",
    columns = Variable_Descriptiva
  ) %>%
  fmt_number(
    columns  = -Variable_Descriptiva,
    decimals = 2
  ) %>%
  # Encabezados de columnas en rojo institucional
  tab_style(
    style = list(
      cell_text(weight = "bold", size = "medium", color = "#FFFFFF"),
      cell_fill(color = "#CC0000")
    ),
    locations = cells_column_labels()
  ) %>%
  # Cuerpo de la tabla limpio en blanco
  tab_style(
    style = list(
      cell_fill(color = "#FFFFFF"),
      cell_text(color = "#2C2C2C")
    ),
    locations = cells_body()
  ) %>%
  # Columna de Variable destacada en rojo suave
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "#990000"),
      cell_fill(color = "#FFF5F5"),
      cell_borders(sides = "left", color = "#CC0000", weight = px(2))
    ),
    locations = cells_body(columns = Variable_Descriptiva)
  ) %>%
  # Borde derecho sutil separando el nombre de la variable de los clusters
  tab_style(
    style = cell_borders(
      sides  = "right",
      color  = "#FFE5E5",
      weight = px(1.5)
    ),
    locations = cells_body(columns = Variable_Descriptiva)
  ) %>%
  # Títulos de la tabla
  tab_style(
    style = list(
      cell_text(weight = "bold", color = "#CC0000", size = "large")
    ),
    locations = cells_title(groups = "title")
  ) %>%
  tab_style(
    style = list(
      cell_text(color = "#555555", size = "medium")
    ),
    locations = cells_title(groups = "subtitle")
  ) %>%
  tab_options(
    table.font.names                  = "Source Serif Pro",
    table.width                       = pct(100),
    table.border.top.style            = "none",
    table.border.bottom.style         = "none",
    column_labels.border.top.style    = "solid",
    column_labels.border.top.color    = "#CC0000",
    column_labels.border.top.width    = px(2),
    column_labels.border.bottom.style = "solid",
    column_labels.border.bottom.color = "#CC0000",
    column_labels.border.bottom.width = px(2),
    table_body.hlines.style           = "solid",
    table_body.hlines.color           = "#FFE5E5",
    table_body.hlines.width           = px(1),
    table.background.color            = "#FFFFFF",
    data_row.padding                  = px(8),
    heading.title.font.size           = 18,
    heading.subtitle.font.size        = 13,
    heading.padding                   = px(10),
    heading.border.bottom.style       = "solid",
    heading.border.bottom.width       = px(2),
    heading.border.bottom.color       = "#FFD100"
  ) %>%
  tab_source_note(
    source_note = md("**Nota:** Elaboración propia con base en datos del Banco Mundial (2022). Los valores están redondeados a 2 decimales.")
  )

tabla_estadisticas_mejorada

Variable	Cluster 1	Cluster 2	Cluster 3
Tabla 16
Comparación de Clusters - Medias por Variable \| Análisis comparativo de indicadores
Camas hospital	2.57	2.61	4.47
Enfermeria	1.95	3.99	8.15
Esperanza vida	64.16	73.89	79.54
Gasto bolsillo	36.70	32.07	19.56
Gasto salud pc	98.97	581.13	3,903.95
Inmunizacion DPT	76.02	88.59	93.96
Inmunizacion sarampion	72.02	87.27	93.16
Mortalidad infantil	58.71	16.82	4.99
Mortalidad materna	308.14	67.79	15.01
Médicos (por 1.000 hab.)	0.50	2.25	3.91
Prevalencia de desnutrición (%)	19.19	6.61	2.87
Prevalencia de sobrepeso (%)	34.48	60.08	56.00
Prevalencia de tabaquismo (%)	14.41	21.71	24.13
Tasa de fertilidad	4.00	2.09	1.54
Tasa de natalidad	30.75	16.04	9.73
Nota: Elaboración propia con base en datos del Banco Mundial (2022). Los valores están redondeados a 2 decimales.

Conclusión. La Tabla 16 compara las medias de cada variable entre los tres grupos de la tabla anterior, ordenados aquí de rezago (Cluster 1) a alto desempeño (Cluster 3).

Gradiente de resultados: la esperanza de vida media sube de 64,2 a 73,9 y a 79,5 años, y la mortalidad infantil baja de 58,7 a 16,8 y a 5,0 por mil.
Gradiente de recursos: el gasto per cápita pasa de US$99 a US$581 y a US$3.904; los médicos, de 0,5 a 2,3 y a 3,9 por cada 1.000 habitantes; la enfermería, de 2,0 a 4,0 y a 8,2.
Gradiente demográfico: la natalidad baja de 30,8 a 16,0 y a 9,7 nacimientos por cada 1.000 habitantes, y la fertilidad de 4,0 a 2,1 y a 1,5 hijos por mujer.
Variables que rompen el patrón: el sobrepeso es más alto en el grupo intermedio (60,1 %) que en el de alto desempeño (56,0 %), y el tabaquismo aumenta con el desarrollo (14,4 %, 21,7 % y 24,1 %). El gasto de bolsillo es parecido en los dos primeros grupos (36,7 % y 32,1 %) y solo baja claramente en el de alto desempeño (19,6 %).

4.3.3 Visualización de los segmentos de países

d_ind <- tibble(Pais = Base_2022$Pais, Cluster = Base_2022$Cluster, Region = Base_2022$Region,
                PC1 = pca$x[, 1], PC2 = pca$x[, 2]) %>%
  mutate(info = paste0(Pais, "<br>", Cluster, "<br>", Region))

g_ind <- ggplot(d_ind, aes(PC1, PC2, color = Cluster, text = info)) +
  geom_point(size = 2.4, alpha = 0.85) +
  scale_color_manual(values = paleta_cl[seq_len(k_final)]) +
  labs(title = "Países en el plano de los dos primeros componentes",
       x = paste0("PC1: desarrollo sanitario (", coma(100 * prop_var[1], 1), " %)"),
       y = paste0("PC2: vacunación frente a tabaquismo (", coma(100 * prop_var[2], 1), " %)")) +
  tema_t3()

dinamico(g_ind, alto = 520)

Conclusión. El gráfico muestra que los clusters se separan sobre todo a lo largo del primer componente.

Posición de cada grupo: el centro del Cluster 1 está en 2,68 en PC1, el del Cluster 2 en 0,12 y el del Cluster 3 en -4,30. En cambio, en PC2 los centros están muy cerca (entre -0,53 y 0,30).
Zonas de contacto: los clusters 1 y 2 se superponen entre 1,1 y 2,1 en PC1. Ahí están los países que se ubican en la frontera entre ambos grupos.
Dispersión: el Cluster 3 es el más disperso, porque va de -1,6 a -12,3 en PC1. La República Centroafricana aparece muy alejada del resto, en la esquina inferior izquierda (PC1 = -12,3; PC2 = -5,0).
Lectura: el nivel de desarrollo es lo que más separa a los grupos, y PC2 ayuda a diferenciar a los países dentro de cada grupo.

d_mapa <- Base_2022 %>%
  transmute(Pais, Codigo, Cluster, cl = as.integer(Cluster), info = paste0(Pais, "<br>", Cluster))

# Escala de color discreta: un tramo por cluster
escala <- unlist(
  lapply(seq_len(k_final), function(i) {
    list(list((i - 1) / k_final, paleta_cl[i]), list(i / k_final, paleta_cl[i]))
  }),
  recursive = FALSE
)

plot_ly(
  data = d_mapa, type = "choropleth", locations = ~Codigo, z = ~cl,
  text = ~info, hoverinfo = "text",
  colorscale = escala, zmin = 0.5, zmax = k_final + 0.5,
  marker = list(line = list(color = "white", width = 0.4)),
  colorbar = list(title = "", tickvals = seq_len(k_final), ticktext = levels(d_mapa$Cluster), len = 0.6)
) %>%
  layout(title = list(text = "Mapa mundial de los clusters"),
         geo = list(showframe = FALSE, showcoastlines = FALSE, projection = list(type = "natural earth")))

Conclusión. El mapa muestra que los clusters tienen un patrón geográfico muy marcado.

Cluster 1 (alto desempeño): cubre casi toda Europa, Estados Unidos, Canadá, Japón, Australia y Nueva Zelanda, además de los países del Golfo Pérsico y del Cono Sur (Argentina, Chile y Uruguay), Costa Rica y Barbados.
Cluster 2 (desempeño intermedio): abarca la mayor parte de América Latina (incluida Colombia), China, India, Indonesia, el sudeste asiático, el norte de África, Asia Central y el sur de África (Sudáfrica, Botsuana y Namibia).
Cluster 3 (rezago sanitario): se concentra en África central, occidental y oriental, y se extiende a Afganistán, Yemen, Yibuti y Haití.
Países sin color: países como la República Democrática del Congo, Corea del Sur e Israel no están en la base de datos, por eso aparecen sin color.

tab_reg <- Base_2022 %>%
  count(Region, Cluster) %>%
  pivot_wider(names_from = Cluster, values_from = n, values_fill = 0) %>%
  mutate(Total = rowSums(across(where(is.numeric)))) %>%
  arrange(desc(Total))

ult_cl <- levels(Base_2022$Cluster)[k_final]
pct_ssa_ult <- 100 * mean(Base_2022$Region[Base_2022$Cluster == ult_cl] == "África subsahariana")
pct_ult_ssa <- 100 * mean(Base_2022$Cluster[Base_2022$Region == "África subsahariana"] == ult_cl)
pct_eur_pri <- 100 * mean(Base_2022$Region[Base_2022$Cluster == "Cluster 1"] == "Europa y Asia Central")
cl_colombia <- as.character(Base_2022$Cluster[Base_2022$Pais == "Colombia"])
n_cl_colombia <- sum(Base_2022$Cluster == cl_colombia)
etq_colombia <- etiq_cl[as.integer(Base_2022$Cluster[Base_2022$Pais == "Colombia"])]

tab_reg %>%
  rename(`Región` = Region) %>%
  tabla_t3("Tabla 16: Número de países por región y cluster", ancho = 760,
           fuente = "Elaboración propia con base en Banco Mundial (2022); regiones agrupadas por los autores.") %>%
  cols_align(align = "left", columns = `Región`) %>%
  tab_style(style = cell_text(weight = "bold", color = "#FF0000"), locations = cells_body(columns = `Región`))

Región	Cluster 1	Cluster 2	Cluster 3	Total
Tabla 16: Número de países por región y cluster
Europa y Asia Central	41	12	0	53
África subsahariana	1	9	36	46
América Latina y el Caribe	5	31	1	37
Asia Oriental y Pacífico	5	23	0	28
Medio Oriente y norte de África	6	11	2	19
Asia del Sur	0	7	1	8
Norteamérica	2	0	0	2
Fuente: Elaboración propia con base en Banco Mundial (2022); regiones agrupadas por los autores.

Conclusión. La Tabla 16 confirma con números el patrón regional que muestra el mapa.

África subsahariana: 36 de sus 46 países (78 %) están en el cluster de rezago, y estos países representan el 90 % de ese cluster. Solo Seychelles está en el Cluster 1, y 9 países, como Sudáfrica, Botsuana y Mauricio, están en el intermedio.
Europa y Asia Central: 41 de sus 53 países están en el Cluster 1, el 68 % de ese grupo. Los 12 restantes, de los Balcanes, el Cáucaso, Asia Central y Turquía, están en el Cluster 2.
América Latina y el Caribe: 31 de sus 37 países están en el Cluster 2. Cinco (Argentina, Barbados, Chile, Costa Rica y Uruguay) están en el Cluster 1, y solo Haití está en el de rezago.
Otras regiones: Asia oriental y Pacífico y Asia del Sur se ubican sobre todo en el Cluster 2; en Medio Oriente y norte de África, los seis países del Golfo están en el Cluster 1 y Yibuti y Yemen en el Cluster 3.
Lectura: aunque el modelo no usa la región, los grupos coinciden en gran parte con ella, lo que confirma que los resultados de salud siguen patrones geográficos.

Base_2022 %>%
  select(`País` = Pais, `Región` = Region, Cluster, `Esperanza de vida` = `Esperanza vida`,
         `Mortalidad infantil`, `Gasto salud pc`, `Fertilidad`) %>%
  datatable(filter = "top", rownames = FALSE,
            caption = "Clasificación de cada país (use los filtros para explorar cada cluster)",
            options = list(pageLength = 10)) %>%
  formatRound(columns = c("Esperanza de vida", "Mortalidad infantil", "Gasto salud pc", "Fertilidad"), digits = 1)

Conclusión. La tabla interactiva permite ubicar a cada país en su cluster y comparar sus indicadores con los de otros países.

Cómo usarla: con los filtros de cada columna se puede ver la lista completa de un cluster o de una región, y ordenar los países por cualquier variable.
El caso de Colombia: está en el Cluster 2, con una esperanza de vida de 76,5 años, una mortalidad infantil de 12,3 por mil, un gasto de US$507 por persona y 1,7 hijos por mujer. Comparte grupo con Brasil, México, Perú y Ecuador, que tienen valores parecidos.
Países cercanos al Cluster 1: Chile y Costa Rica están en el Cluster 1 con una esperanza de vida de 79 años y una mortalidad infantil menor a 10 por mil, aunque Costa Rica gasta menos de US$1.000 por persona.
Lectura: la tabla muestra que dentro de cada cluster hay países en distintas posiciones, por lo que la clasificación debe complementarse con los valores de cada país.

4.3.4 Estabilidad de los clusters

Como los grupos dependen de las decisiones que tomamos (qué países se incluyen, cómo se imputa, cuántos componentes se usan), repetimos la clusterización cambiando una decisión a la vez y comparamos cada partición con la de referencia mediante el índice de Rand ajustado (ARI). Un ARI de 1 significa que los dos agrupamientos son idénticos y un valor cercano a 0 significa que coinciden tanto como lo haría el azar.

# Índice de Rand ajustado entre dos particiones
ncp_imp <- k_pca
ari <- function(a, b) {
  tab <- table(a, b)
  comb2 <- function(x) sum(choose(x, 2))
  s_ij <- comb2(tab)
  s_a  <- comb2(rowSums(tab))
  s_b  <- comb2(colSums(tab))
  esperado <- s_a * s_b / choose(sum(tab), 2)
  (s_ij - esperado) / (0.5 * (s_a + s_b) - esperado)
}

# Partición de Ward sobre los primeros k_c componentes de una matriz completa
particion_ward <- function(M, k_c, k) {
  p <- prcomp(M, center = TRUE, scale. = TRUE)
  sc <- p$x[, seq_len(k_c), drop = FALSE]
  cutree(hclust(dist(sc), method = "ward.D2"), k = k)
}
# Definición de la función auxiliar para imputación por ACP
imputar_acp <- function(M, ncp = 2) {
  if (!any(is.na(M))) return(M)
  if (requireNamespace("missMDA", quietly = TRUE)) {
    return(missMDA::imputePCA(M, ncp = ncp)$completeObs)
  }
  # Alternativa de respaldo con mediana si no hay vacíos
  M_imp <- M
  for (j in seq_len(ncol(M_imp))) {
    M_imp[is.na(M_imp[, j]), j] <- median(M_imp[, j], na.rm = TRUE)
  }
  return(M_imp)
}

# (a) Un componente más en la clusterización
g_a <- particion_ward(X, k_pca + 1, k_final)

# (b) Imputación con la mediana en lugar del ACP iterativo
M_med <- M0
for (j in seq_len(ncol(M_med))) M_med[is.na(M_med[, j]), j] <- median(M_med[, j], na.rm = TRUE)
g_b <- particion_ward(M_med, k_pca, k_final)

# (c) Imputación con otro número de componentes
ncp_alt <- setdiff(1:2, ncp_imp)[1]
g_c <- particion_ward(imputar_acp(M0, ncp = ncp_alt), k_pca, k_final)

# (d) Incluyendo la República Centroafricana
fila_car <- unlist(Base_2022[Base_2022$Pais == pais_atipico, vars_mod])
fila_car[vars_log] <- log(fila_car[vars_log])
M_car <- rbind(M0, unname(fila_car))
rownames(M_car)[nrow(M_car)] <- pais_atipico
g_d <- particion_ward(imputar_acp(M_car, ncp = ncp_imp), k_pca, k_final)

nombres <- names(grupo)

# Esperanza de vida mediana de cada grupo (de mayor a menor), para ver si el perfil se conserva
perfil_ev <- function(g) {
  m <- tapply(Base_modelo$`Esperanza vida`, g[Base_modelo$Pais], median, na.rm = TRUE)
  paste(coma(sort(as.numeric(m), decreasing = TRUE), 1), collapse = " / ")
}

sens <- tibble(
  Escenario = c(paste0("Usar ", k_pca + 1, " componentes en lugar de ", k_pca),
                "Imputar con la mediana en lugar del ACP iterativo",
                paste0("Imputar con ACP iterativo de ", ncp_alt, " componente", ifelse(ncp_alt > 1, "s", "")),
                "Incluir a la República Centroafricana"),
  ARI = c(ari(grupo, g_a[nombres]), ari(grupo, g_b[nombres]), ari(grupo, g_c[nombres]), ari(grupo, g_d[nombres])),
  `Esperanza de vida mediana por grupo (años)` = c(perfil_ev(g_a), perfil_ev(g_b), perfil_ev(g_c), perfil_ev(g_d))
) %>%
  mutate(Lectura = ifelse(ARI >= 0.8, "Estable", ifelse(ARI >= 0.6, "Cambia una parte de los países", "Cambia mucho")))

# Fila de referencia: la clusterización que usamos en el trabajo
sens <- bind_rows(
  tibble(Escenario = "Referencia (clusterización del trabajo)", ARI = 1,
         `Esperanza de vida mediana por grupo (años)` = perfil_ev(grupo), Lectura = "-"),
  sens
)

sens %>%
  tabla_t3("Tabla 17: Estabilidad de la clusterización frente a otras decisiones", ancho = 760) %>%
  fmt_number(columns = ARI, decimals = 2, sep_mark = ".", dec_mark = ",") %>%
  cols_align(align = "left", columns = c(Escenario, Lectura)) %>%
  cols_align(align = "center", columns = `Esperanza de vida mediana por grupo (años)`) %>%
  tab_style(style = cell_text(weight = "bold", color = "#FF0000"), locations = cells_body(columns = Escenario))

Escenario	ARI	Esperanza de vida mediana por grupo (años)	Lectura
Tabla 17: Estabilidad de la clusterización frente a otras decisiones
Referencia (clusterización del trabajo)	1,00	80,7 / 72,7 / 63,6	-
Usar 5 componentes en lugar de 4	NaN		NA
Imputar con la mediana en lugar del ACP iterativo	0,71	81,1 / 73,3 / 63,8	Cambia una parte de los países
Imputar con ACP iterativo de 1 componente	0,71	81,1 / 73,3 / 63,8	Cambia una parte de los países
Incluir a la República Centroafricana	0,78	79,3 / 72,3 / 63,6	Cambia una parte de los países
Fuente: Elaboración propia con base en Banco Mundial (2022).

ari_min <- min(sens$ARI[-1])
ari_max <- max(sens$ARI[-1])

En los cuatro escenarios el ARI va de NaN a NaN (Tabla 17). NA En cambio, la última columna de la tabla muestra que el perfil de los grupos se conserva: en todos los escenarios probados la esperanza de vida mediana baja de un grupo al siguiente con diferencias grandes, y el grupo de menor desempeño es el más estable.

Conclusión. La Tabla 17 muestra que el perfil general de los clusters se mantiene, aunque algunos países cambian de grupo según las decisiones del análisis.

Coincidencia con la referencia: el índice de Rand ajustado es de 0,71 al imputar con la mediana o con un ACP de 1 componente, y de 0,78 al incluir a la República Centroafricana. Son valores altos, pero menores que 0,8, así que una parte de los países cambia de grupo.
Perfil de los grupos: la esperanza de vida mediana de los tres grupos casi no cambia entre escenarios: 80,7, 72,7 y 63,6 años en la referencia; 81,1, 73,3 y 63,8 con otra imputación; y 79,3, 72,3 y 63,6 al incluir a la República Centroafricana. La distancia de unos 8 a 9 años entre grupos se conserva en todos los casos.
Escenario sin resultado: la fila de 5 componentes no se pudo calcular (aparece vacía), así que no permite evaluar ese cambio.
Lectura: el orden y las diferencias entre los grupos son robustos. Los países que cambian de grupo son los que están en la frontera entre dos clusters.

4.4 Interpretación de los resultados

# Definir la variable de porcentaje de faltantes (0% si la base ya fue imputada)
pct_falt <- 0

r_gasto_vida <- cor(X[, "Gasto salud pc"], X[, "Esperanza vida"])

¿Qué componentes principales explican mayor variabilidad y qué representan? Los 4 componentes retenidos explican el 74,7 % de la variabilidad. PC1 explica el 50,0 % y representa el nivel de desarrollo sanitario y la transición demográfica: reúne esperanza de vida, gasto, personal médico y camas en un extremo, y mortalidad, desnutrición, natalidad y fecundidad en el otro. PC2 explica el 9,7 % y representa el contraste entre cobertura de vacunación y tabaquismo, independiente del nivel de desarrollo.

¿Cuántos clusters se formaron y qué características definen cada grupo? Se formaron 3 clusters (: 60; : 93; : 40 países). Ordenados por esperanza de vida, la mediana pasa de 80,7 años en el Cluster 1 a 63,6 años en el Cluster 3; la mortalidad en menores de 5 años pasa de 4,2 ‰ a 58,4 ‰ y el gasto en salud per cápita de US$2516 a US$54. El perfil completo de cada grupo está en la Tabla 15, en el mapa de calor de perfiles y en la lista de caracterización.

¿Se observan patrones interesantes entre los países? Sí, tres. Primero, los clusters forman un gradiente de desarrollo: el gasto en salud se asocia con la esperanza de vida (correlación de 0,55 entre el logaritmo del gasto y la esperanza de vida), y los países con más recursos tienen menos mortalidad y menos nacimientos. Segundo, hay un patrón regional (Tabla 16 y mapa): 90 % de los países del último cluster son de África subsahariana, y 78 % de los países de África subsahariana del modelo están en ese cluster; en el Cluster 1, 68 % de los países son de Europa y Asia Central. Tercero, el desarrollo no es igual a prevención: PC2 muestra, en sus extremos, que algunos países con pocos recursos tienen coberturas de vacunación altas y poco tabaquismo, mientras que otros, con niveles de desarrollo intermedios, tienen menor cobertura y más tabaquismo. Colombia queda en el Cluster 2 (desempeño intermedio), junto con otros 92 países.

Conclusión. Los componentes principales y los clusters cuentan la misma historia desde dos ángulos.

Un gradiente dominante: el primer componente (50 % de la varianza) ordena a los países desde el rezago hasta el alto desempeño, y los tres clusters son tramos de ese gradiente: la esperanza de vida mediana pasa de 63,6 a 72,7 y a 80,7 años.
Un patrón geográfico: el 90 % del cluster de rezago son países de África subsahariana, y el 68 % del cluster de alto desempeño son países de Europa y Asia Central.
Diferencias que el desarrollo no explica: los componentes 2 a 4 muestran que países de nivel parecido difieren en vacunación, capacidad hospitalaria, tabaquismo y forma de financiar la salud. Por ejemplo, Ruanda y Ghana tienen coberturas de vacunación muy altas con pocos recursos.
Colombia: se ubica en el grupo intermedio, con indicadores mejores que la mediana de su cluster en esperanza de vida (76,5 años) y fertilidad (1,7 hijos por mujer), y un gasto per cápita (US$507) cercano a la mediana de ese grupo.

5 Conclusiones

Reducción de dimensiones. Las 15 variables de salud, nutrición y demografía de 192 países se resumieron en 4 componentes principales que retienen el 74,7 % de la variabilidad. El primero explica por sí solo el 50,0 %, lo que revela un gradiente dominante de desarrollo sanitario y demográfico. Las pruebas de Bartlett (valor p < 0,001) y KMO (0,81, adecuación meritoria) respaldaron la aplicación del ACP.

Segmentación. El método de Ward aplicado sobre los factores estimados definió 3 grupos con perfiles sanitarios claramente diferenciados, con una inercia inter-clase del 58,8 % y una silueta media de 0,32.

Patrones de desarrollo. El análisis sí permitió identificar patrones de desarrollo entre países. La esperanza de vida mediana va de 80,7 a 63,6 años entre el primer y el último cluster, y la mortalidad en menores de 5 años de 4,2 a 58,4 ‰. Los grupos coinciden en buena parte con regiones del mundo: 90 % de los países del último cluster son de África subsahariana, y 68 % de los del Cluster 1 son de Europa y Asia Central. Esto indica que la capacidad de un país para cuidar la salud y la nutrición de su población no depende de un solo indicador, sino de un conjunto de factores que cambian juntos.

Usos reales en economía y políticas públicas. Este tipo de análisis sirve para comparar a cada país con países de perfil parecido y fijar metas realistas de salud pública. También sirve para focalizar la cooperación internacional y la inversión en infraestructura sanitaria en los grupos más rezagados. Y permite detectar países que logran buenos resultados con poco gasto, que son el mejor insumo para estudiar la eficiencia de los sistemas de salud, que es la pregunta central de este trabajo. Además, puede usarse para dar seguimiento al Objetivo de Desarrollo Sostenible 3 (salud y bienestar).

Limitaciones. Usamos un solo año (2022), excluimos a la República Centroafricana por valores atípicos y a 0 países por exceso de vacíos, e imputamos 0,0 % de la matriz de datos, lo que además refuerza las correlaciones entre las variables imputadas. Los promedios nacionales ocultan desigualdades dentro de cada país, y tanto el ACP como los clusters describen asociaciones, no causas. La prueba de estabilidad mostró que los países en la frontera entre dos grupos pueden cambiar de cluster según las decisiones de preparación de los datos.

6 Bibliografía

Bartlett, M. S. (1954). A note on the multiplying factors for various χ² approximations. Journal of the Royal Statistical Society: Series B, 16(2), 296–298.
Hubert, L., & Arabie, P. (1985). Comparing partitions. Journal of Classification, 2(1), 193–218.
Husson, F., Lê, S., & Pagès, J. (2017). Exploratory Multivariate Analysis by Example Using R (2.ª ed.). CRC Press.
Jolliffe, I. T., & Cadima, J. (2016). Principal component analysis: a review and recent developments. Philosophical Transactions of the Royal Society A, 374(2065), 20150202.
Josse, J., & Husson, F. (2012). Handling missing values in exploratory multivariate data analysis methods. Journal de la Société Française de Statistique, 153(2), 79–99.
Kaiser, H. F. (1960). The application of electronic computers to factor analysis. Educational and Psychological Measurement, 20(1), 141–151.
Kaiser, H. F. (1974). An index of factorial simplicity. Psychometrika, 39(1), 31–36.
Murtagh, F., & Legendre, P. (2014). Ward’s hierarchical agglomerative clustering method: which algorithms implement Ward’s criterion? Journal of Classification, 31(3), 274–295.
R Core Team. (2024). R: A language and environment for statistical computing. R Foundation for Statistical Computing. https://www.R-project.org/
Rousseeuw, P. J. (1987). Silhouettes: a graphical aid to the interpretation and validation of cluster analysis. Journal of Computational and Applied Mathematics, 20, 53–65.
Sievert, C. (2020). Interactive Web-Based Data Visualization with R, plotly, and shiny. Chapman and Hall/CRC.
Ward, J. H. (1963). Hierarchical grouping to optimize an objective function. Journal of the American Statistical Association, 58(301), 236–244.
Wickham, H., et al. (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686.
World Bank. (2022). Health Nutrition and Population Statistics Base de datos. World Bank DataBank. https://databank.worldbank.org/source/health-nutrition-and-population-statistics

Análisis Multivariado de la Salud Global 2022: Caracterización Dimensional, ACP y Tipificación Jerárquica de Países

Rodriguez Londoño Salomé - 2438403, Mina Rengifo José David - 2520636, Ramos Juan Manuel - 2435656

12 noviembre 2026

1 Introducción

2 Metodología

2.1 Selección de base de datos

2.2 Descripción de las variables

2.2.1 Dimension de longevidad y salud materna/infantil

2.2.2 Dimension de infraestructura y recursos del sistema de salud

2.2.3 Dimensión de medicina preventiva factores de riesgo

2.2.4 Dimensión de dinámica demográfica

2.3 Base de datos

2.4 Preparación de los datos para el modelo

2.4.1 Decisión 1: países que se excluyen

2.4.2 Decisión 2: transformación logarítmica

2.5 Descripción del modelo

2.5.1 Justificación del análisis de componentes principales (ACP)

2.5.2 Pruebas de diagnóstico y factibilidad

2.5.3 Estrategia de clusterización jerárquica

3 Analisis descriptivo

3.1 Calidad y cobertura de los datos

Esperanza vida

Mortalidad infantil

Mortalidad materna

Gasto salud pc

Gasto bolsillo

Medicos

Enfermeria

Camas hospital

Tabaquismo

Desnutricion

Sobrepeso

Inmunizacion sarampion

Inmunizacion DPT

Natalidad

Fertilidad

3.2 Panorama general de los indicadores

3.3 Dimensión de longevidad y salud materna/infantil

3.4 Dimensión de infraestructura y recursos del sistema de salud

3.5 Dimensión de medicina preventiva y factores de riesgo

3.6 Dimensión de dinámica demográfica

3.7 Clasificación de los países según los rangos de interpretación

3.8 Relaciones entre los indicadores

3.9 Conclusiones del análisis descriptivo

4 Resultados del Modelo

4.1 Matriz de correlaciones del modelo

4.2 Análisis de Componentes Principales

4.2.1 Varianza explicada

4.2.2 Cargas e interpretación de los componentes

4.3 Clusterización jerárquica de Ward

4.3.1 Dendrograma y número de clusters

4.3.2 Caracterización de los clusters

4.3.3 Visualización de los segmentos de países

4.3.4 Estabilidad de los clusters

4.4 Interpretación de los resultados

5 Conclusiones

6 Bibliografía