Análisis de Componentes Principales - Mortalidad Global
Tu Nombre
2025-11-17
Preparación inicial datos y base
##Librerías
library(readr)
library(tidyverse)
library(FactoMineR)
library(factoextra)
library(reactable)
library(htmltools)
library(ggplot2)
library(plotly)
library(ggrepel)
library(dendextend)
library(viridis)
library(FactoClass)
library(dplyr)
library(tidyr)
library(ggforce)
library(cluster)
library(ggplot2)
library(reshape2)
library(reshape2)
library(ggplot2)
library(reactable)
library(reactablefmtr)
library(kableExtra)##Cargar y Preparar Datos
# Leer la base
Muertes_ans <- read_csv("Muertes ans.csv", locale = locale(encoding = "UTF-8"))
Muertes <- data.frame(Muertes_ans)
# Limpieza y selección de variables
Muertes <- Muertes[-(218:245), ]
Muertes <- na.omit(Muertes)
colnames(Muertes) <- c("Pais", "Expectativa_de_vida_mujer", "Expectativa_de_vida_hombres",
"Accidentes_de_transito", "Enfermedades_cardiacas_cancer_diabetes_mujeres",
"Enfermedades_cardiacas_cancer_diabetes_hombres", "Polucion_del_aire_mujeres",
"Polucion_del_aire_hombres", "Envenenamiento_accidental_mujeres",
"Envenenamiento_accidental_hombres", "Tasa_de_mortalidad_mujeres_adultas",
"Tasa_de_mortalidad_hombres_adultos", "Tasa_de_mortalidad_infantil_mujeres",
"Tasa_de_mortalidad_infantil_varones", "Tasa_de_mortalidad_neonatal",
"Tasa_de_mortalidad_infantil_temprana_mujeres",
"Tasa_de_mortalidad_infantil_temprana_hombres", "Numero_de_muertes_infantiles",
"Numero_de_muertes_neonatales", "Tasa_de_suicidios_mujeres",
"Tasa_de_suicidios_hombres", "Supervivencia_hasta_los_65_anos_mujeres",
"Supervivencia_hasta_los_65_anos_hombres")
# Eliminar filas con valores NA
Muertes <- Muertes %>%
filter(complete.cases(.))
# Traducir nombres de países al español
Muertes <- Muertes %>%
mutate(Pais = case_when(
Pais == "Faroe Islands" ~ "Islas Feroe",
Pais == "Fiji" ~ "Fiyi",
Pais == "Finland" ~ "Finlandia",
Pais == "France" ~ "Francia",
Pais == "French Polynesia" ~ "Polinesia Francesa",
Pais == "Gabon" ~ "Gabon",
Pais == "Gambia, The" ~ "Gambia",
Pais == "Georgia" ~ "Georgia",
Pais == "Germany" ~ "Alemania",
Pais == "Ghana" ~ "Ghana",
Pais == "Gibraltar" ~ "Gibraltar",
Pais == "Greece" ~ "Grecia",
Pais == "Greenland" ~ "Groenlandia",
Pais == "Grenada" ~ "Granada",
Pais == "Guam" ~ "Guam",
Pais == "Guatemala" ~ "Guatemala",
Pais == "Guinea" ~ "Guinea",
Pais == "Guinea-Bissau" ~ "Guinea-Bisau",
Pais == "Guyana" ~ "Guyana",
Pais == "Haiti" ~ "Haiti",
Pais == "Honduras" ~ "Honduras",
Pais == "Hong Kong SAR, China" ~ "Hong Kong",
Pais == "Hungary" ~ "Hungria",
Pais == "Iceland" ~ "Islandia",
Pais == "India" ~ "India",
Pais == "Indonesia" ~ "Indonesia",
Pais == "Iran, Islamic Rep." ~ "Iran",
Pais == "Iraq" ~ "Irak",
Pais == "Ireland" ~ "Irlanda",
Pais == "Isle of Man" ~ "Isla de Man",
Pais == "Israel" ~ "Israel",
Pais == "Italy" ~ "Italia",
Pais == "Jamaica" ~ "Jamaica",
Pais == "Japan" ~ "Japon",
Pais == "Jordan" ~ "Jordania",
Pais == "Kazakhstan" ~ "Kazajistan",
Pais == "Kenya" ~ "Kenia",
Pais == "Kiribati" ~ "Kiribati",
Pais == "Korea, Dem. People's Rep." ~ "Corea del Norte",
Pais == "Korea, Rep." ~ "Corea del Sur",
Pais == "Kosovo" ~ "Kosovo",
Pais == "Kuwait" ~ "Kuwait",
Pais == "Kyrgyz Republic" ~ "Kirguistan",
Pais == "Lao PDR" ~ "Laos",
Pais == "Latvia" ~ "Letonia",
Pais == "Lebanon" ~ "Libano",
Pais == "Lesotho" ~ "Lesoto",
Pais == "Liberia" ~ "Liberia",
Pais == "Libya" ~ "Libia",
Pais == "Liechtenstein" ~ "Liechtenstein",
Pais == "Lithuania" ~ "Lituania",
Pais == "Luxembourg" ~ "Luxemburgo",
Pais == "Macao SAR, China" ~ "Macao",
Pais == "Madagascar" ~ "Madagascar",
Pais == "Malawi" ~ "Malaui",
Pais == "Malaysia" ~ "Malasia",
Pais == "Maldives" ~ "Maldivas",
Pais == "Mali" ~ "Mali",
Pais == "Malta" ~ "Malta",
Pais == "Marshall Islands" ~ "Islas Marshall",
Pais == "Mauritania" ~ "Mauritania",
Pais == "Mauritius" ~ "Mauricio",
Pais == "Mexico" ~ "Mexico",
Pais == "Micronesia, Fed. Sts." ~ "Micronesia",
Pais == "Moldova" ~ "Moldavia",
Pais == "Monaco" ~ "Monaco",
Pais == "Mongolia" ~ "Mongolia",
Pais == "Montenegro" ~ "Montenegro",
Pais == "Morocco" ~ "Marruecos",
Pais == "Mozambique" ~ "Mozambique",
Pais == "Myanmar" ~ "Myanmar",
Pais == "Namibia" ~ "Namibia",
Pais == "Nauru" ~ "Nauru",
Pais == "Nepal" ~ "Nepal",
Pais == "Netherlands" ~ "Paises Bajos",
Pais == "New Caledonia" ~ "Nueva Caledonia",
Pais == "New Zealand" ~ "Nueva Zelanda",
Pais == "Nicaragua" ~ "Nicaragua",
Pais == "Niger" ~ "Niger",
Pais == "Nigeria" ~ "Nigeria",
Pais == "North Macedonia" ~ "Macedonia del Norte",
Pais == "Northern Mariana Islands" ~ "Islas Marianas del Norte",
Pais == "Norway" ~ "Noruega",
Pais == "Oman" ~ "Oman",
Pais == "Pakistan" ~ "Pakistan",
Pais == "Palau" ~ "Palaos",
Pais == "Panama" ~ "Panama",
Pais == "Papua New Guinea" ~ "Papua Nueva Guinea",
Pais == "Paraguay" ~ "Paraguay",
Pais == "Peru" ~ "Peru",
Pais == "Philippines" ~ "Filipinas",
Pais == "Poland" ~ "Polonia",
Pais == "Portugal" ~ "Portugal",
Pais == "Puerto Rico (US)" ~ "Puerto Rico",
Pais == "Qatar" ~ "Catar",
Pais == "Romania" ~ "Rumania",
Pais == "Russian Federation" ~ "Rusia",
Pais == "Rwanda" ~ "Ruanda",
Pais == "Samoa" ~ "Samoa",
Pais == "San Marino" ~ "San Marino",
Pais == "Sao Tome and Principe" ~ "Santo Tome y Principe",
Pais == "Saudi Arabia" ~ "Arabia Saudita",
Pais == "Senegal" ~ "Senegal",
Pais == "Serbia" ~ "Serbia",
Pais == "Seychelles" ~ "Seychelles",
Pais == "Sierra Leone" ~ "Sierra Leona",
Pais == "Singapore" ~ "Singapur",
Pais == "Sint Maarten (Dutch part)" ~ "Sint Maarten",
Pais == "Slovak Republic" ~ "Eslovaquia",
Pais == "Slovenia" ~ "Eslovenia",
Pais == "Solomon Islands" ~ "Islas Salomon",
Pais == "Somalia, Fed. Rep." ~ "Somalia",
Pais == "South Africa" ~ "Sudafrica",
Pais == "South Sudan" ~ "Sudan del Sur",
Pais == "Spain" ~ "Espana",
Pais == "Sri Lanka" ~ "Sri Lanka",
Pais == "St. Kitts and Nevis" ~ "San Cristobal y Nieves",
Pais == "St. Lucia" ~ "Santa Lucia",
Pais == "St. Martin (French part)" ~ "San Martin",
Pais == "St. Vincent and the Grenadines" ~ "San Vicente y las Granadinas",
Pais == "Sudan" ~ "Sudan",
Pais == "Suriname" ~ "Surinam",
Pais == "Sweden" ~ "Suecia",
Pais == "Switzerland" ~ "Suiza",
Pais == "Syrian Arab Republic" ~ "Siria",
Pais == "Tajikistan" ~ "Tayikistan",
Pais == "Tanzania" ~ "Tanzania",
Pais == "Thailand" ~ "Tailandia",
Pais == "Timor-Leste" ~ "Timor Oriental",
Pais == "Togo" ~ "Togo",
Pais == "Tonga" ~ "Tonga",
Pais == "Trinidad and Tobago" ~ "Trinidad y Tobago",
Pais == "Tunisia" ~ "Tunez",
Pais == "Turkiye" ~ "Turquia",
Pais == "Turkmenistan" ~ "Turkmenistan",
Pais == "Turks and Caicos Islands" ~ "Islas Turcas y Caicos",
Pais == "Tuvalu" ~ "Tuvalu",
Pais == "Uganda" ~ "Uganda",
Pais == "Ukraine" ~ "Ucrania",
Pais == "United Arab Emirates" ~ "Emiratos Arabes Unidos",
Pais == "United Kingdom" ~ "Reino Unido",
Pais == "United States" ~ "Estados Unidos",
Pais == "Uruguay" ~ "Uruguay",
Pais == "Uzbekistan" ~ "Uzbekistan",
Pais == "Vanuatu" ~ "Vanuatu",
Pais == "Venezuela, RB" ~ "Venezuela",
Pais == "Viet Nam" ~ "Vietnam",
Pais == "Virgin Islands (U.S.)" ~ "Islas Virgenes Americanas",
Pais == "West Bank and Gaza" ~ "Palestina",
Pais == "Yemen, Rep." ~ "Yemen",
Pais == "Zambia" ~ "Zambia",
Pais == "Zimbabwe" ~ "Zimbabue",
TRUE ~ as.character(Pais)
))
# Verificar la base final
print(paste("Número de países después de la limpieza:", nrow(Muertes)))
print("Estructura de la base:")
str(Muertes)Análisis de Componentes Principales
# Preparar base para ACP
Muertes_df <- Muertes %>%
select(-Pais) %>%
mutate(across(everything(), as.numeric)) %>%
scale()
rownames(Muertes_df) <- Muertes$Pais
head(Muertes_df[, 1:6])
# Realizar el ACP con datos ya escalados
res.pca <- prcomp(Muertes_df, scale = FALSE)
res.pca##matriz correlaciones
nombres_cortos <- c(
"Expectativa_de_vida_mujer" = "Exp Vida Mujer",
"Expectativa_de_vida_hombres" = "Exp Vida Hombre",
"Accidentes_de_transito" = "Accidentes Tránsito",
"Enfermedades_cardiacas_cancer_diabetes_mujeres" = "Enf Crónicas Mujer",
"Enfermedades_cardiacas_cancer_diabetes_hombres" = "Enf Crónicas Hombre",
"Polucion_del_aire_mujeres" = "Polución Aire Mujer",
"Polucion_del_aire_hombres" = "Polución Aire Hombre",
"Envenenamiento_accidental_mujeres" = "Envenenamiento Mujer",
"Envenenamiento_accidental_hombres" = "Envenenamiento Hombre",
"Tasa_de_mortalidad_mujeres_adultas" = "Mort Adulta Mujer",
"Tasa_de_mortalidad_hombres_adultos" = "Mort Adulta Hombre",
"Tasa_de_mortalidad_infantil_mujeres" = "Mort Infantil Mujer",
"Tasa_de_mortalidad_infantil_varones" = "Mort Infantil Hombre",
"Tasa_de_mortalidad_neonatal" = "Mort Neonatal",
"Tasa_de_mortalidad_infantil_temprana_mujeres" = "Mort Temprana Mujer",
"Tasa_de_mortalidad_infantil_temprana_hombres" = "Mort Temprana Hombre",
"Numero_de_muertes_infantiles" = "Muertes Infantiles",
"Numero_de_muertes_neonatales" = "Muertes Neonatales",
"Tasa_de_suicidios_mujeres" = "Suicidios Mujer",
"Tasa_de_suicidios_hombres" = "Suicidios Hombre",
"Supervivencia_hasta_los_65_anos_mujeres" = "Superv 65 Mujer",
"Supervivencia_hasta_los_65_anos_hombres" = "Superv 65 Hombre"
)
variables_requeridas <- names(nombres_cortos)
Muertes_filtradas <- Muertes[, variables_requeridas]
Muertes_filtradas[] <- lapply(Muertes_filtradas, as.numeric)
colnames(Muertes_filtradas) <- nombres_cortos
Muertes_filtradas <- na.omit(Muertes_filtradas)
cor_matrix <- cor(Muertes_filtradas, use = "pairwise.complete.obs")
cor_melted <- melt(cor_matrix)
names(cor_melted) <- c("Var1", "Var2", "value")
p1 <- ggplot(cor_melted, aes(Var1, Var2, fill = value)) +
geom_tile(color = "grey90") +
scale_fill_gradient2(
low = "#d73027",
high = "#4575b4",
mid = "white",
midpoint = 0,
limits = c(-1, 1),
name = "Correlación"
) +
theme_minimal(base_size = 14) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
axis.text.y = element_text(size = 12),
panel.grid = element_blank()
) +
labs(
title = "Matriz de Correlaciones",
x = "",
y = ""
)
print(p1)
Gráfico de Sedimentación
p2 <- fviz_eig(res.pca,
addlabels = TRUE,
barfill = "#2E8B57",
barcolor = "#2E8B57",
linecolor = "#FF6B35",
choice = "variance",
geom = "bar",
main = "ANÁLISIS DE COMPONENTES PRINCIPALES - SCREE PLOT",
xlab = "Número de Componente Principal",
ylab = "Porcentaje de Varianza Explicada",
ggtheme = theme_minimal()) +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 16),
axis.title = element_text(face = "bold", size = 12),
axis.text = element_text(size = 10),
panel.grid.major = element_line(color = "grey90"),
panel.grid.minor = element_blank()
)
print(p2)
Definición de Nombres Cortos para Variables
nombres_cortos_var <- c(
"Expectativa_de_vida_mujer" = "Exp Vida Mujer",
"Expectativa_de_vida_hombres" = "Exp Vida Hombre",
"Accidentes_de_transito" = "Accidentes Tránsito",
"Enfermedades_cardiacas_cancer_diabetes_mujeres" = "Enf Crónicas Mujer",
"Enfermedades_cardiacas_cancer_diabetes_hombres" = "Enf Crónicas Hombre",
"Polucion_del_aire_mujeres" = "Polución Aire Mujer",
"Polucion_del_aire_hombres" = "Polución Aire Hombre",
"Envenenamiento_accidental_mujeres" = "Envenenamiento Mujer",
"Envenenamiento_accidental_hombres" = "Envenenamiento Hombre",
"Tasa_de_mortalidad_mujeres_adultas" = "Mort Adulta Mujer",
"Tasa_de_mortalidad_hombres_adultos" = "Mort Adulta Hombre",
"Tasa_de_mortalidad_infantil_mujeres" = "Mort Infantil Mujer",
"Tasa_de_mortalidad_infantil_varones" = "Mort Infantil Hombre",
"Tasa_de_mortalidad_neonatal" = "Mort Neonatal",
"Tasa_de_mortalidad_infantil_temprana_mujeres" = "Mort Temprana Mujer",
"Tasa_de_mortalidad_infantil_temprana_hombres" = "Mort Temprana Hombre",
"Numero_de_muertes_infantiles" = "Muertes Infantiles",
"Numero_de_muertes_neonatales" = "Muertes Neonatales",
"Tasa_de_suicidios_mujeres" = "Suicidios Mujer",
"Tasa_de_suicidios_hombres" = "Suicidios Hombre",
"Supervivencia_hasta_los_65_anos_mujeres" = "Superv 65 Mujer",
"Supervivencia_hasta_los_65_anos_hombres" = "Superv 65 Hombre"
)Preparación de Datos para Círculos de Correlación
var_coord <- res.pca$rotation
# Calcular eigenvalues y porcentajes de varianza
eigenvalues <- res.pca$sdev^2
total_variance <- sum(eigenvalues)
percent_pc1 <- round((eigenvalues[1] / total_variance) * 100, 1)
percent_pc2 <- round((eigenvalues[2] / total_variance) * 100, 1)
percent_pc3 <- round((eigenvalues[3] / total_variance) * 100, 1)
# Contribución para el gráfico PC1 vs PC2
contrib_12_PC1 <- (var_coord[,1]^2 * eigenvalues[1]) / (eigenvalues[1] + eigenvalues[2]) * 100
contrib_12_PC2 <- (var_coord[,2]^2 * eigenvalues[2]) / (eigenvalues[1] + eigenvalues[2]) * 100
contrib_12_total <- contrib_12_PC1 + contrib_12_PC2
# Contribución para el gráfico PC1 vs PC3
contrib_13_PC1 <- (var_coord[,1]^2 * eigenvalues[1]) / (eigenvalues[1] + eigenvalues[3]) * 100
contrib_13_PC3 <- (var_coord[,3]^2 * eigenvalues[3]) / (eigenvalues[1] + eigenvalues[3]) * 100
contrib_13_total <- contrib_13_PC1 + contrib_13_PC3
# Calcular cos2 (calidad de representación)
cos2_total <- rowSums(var_coord^2)
cos2_PC1_PC2 <- (var_coord[,1]^2 + var_coord[,2]^2) / cos2_total
cos2_PC1_PC3 <- (var_coord[,1]^2 + var_coord[,3]^2) / cos2_total
# Preparar dataframe con los datos CORRECTOS
df_var_plot <- data.frame(
Variable = rownames(var_coord),
PC1 = var_coord[,1],
PC2 = var_coord[,2],
PC3 = var_coord[,3],
Contrib_12 = contrib_12_total, # Contribución para gráfico PC1-PC2
Contrib_13 = contrib_13_total, # Contribución para gráfico PC1-PC3
Cos2_PC1_PC2 = cos2_PC1_PC2,
Cos2_PC1_PC3 = cos2_PC1_PC3
)
# Aplicar nombres cortos
df_var_plot$Variable_corto <- nombres_cortos_var[df_var_plot$Variable]
# Si no hay nombres cortos, usar los originales
df_var_plot$Variable_corto[is.na(df_var_plot$Variable_corto)] <-
df_var_plot$Variable[is.na(df_var_plot$Variable_corto)]library(factoextra)
pca_data <- get_pca_ind(res.pca)
df <- data.frame(
País = rownames(pca_data$coord),
PC1 = pca_data$coord[,1],
PC2 = pca_data$coord[,2]
)
if(!is.null(pca_data$cos2)) {
df$Cos2 <- rowSums(pca_data$cos2[,1:2])
} else {
df$Cos2 <- (df$PC1^2 + df$PC2^2) / rowSums(pca_data$coord^2)
}
if(inherits(res.pca, "PCA")) {
percent_pc1 <- round(res.pca$eig[1,2], 1)
percent_pc2 <- round(res.pca$eig[2,2], 1)
} else {
eigenvalues <- res.pca$sdev^2
total_variance <- sum(eigenvalues)
percent_pc1 <- round((eigenvalues[1] / total_variance) * 100, 1)
percent_pc2 <- round((eigenvalues[2] / total_variance) * 100, 1)
}
# Gráfico 2D interactivo
p3 <- plot_ly(df, x = ~PC1, y = ~PC2,
type = 'scatter',
mode = 'markers',
marker = list(
size = 8,
color = ~Cos2,
colorscale = list(
c(0, "#00AFBB"),
c(0.5, "#E7B800"),
c(1, "#FC4E07")
),
showscale = TRUE,
colorbar = list(title = "cos2"),
opacity = 0.8,
line = list(
width = 1,
color = 'darkgray'
)
),
text = ~paste('<b>País:</b>', País,
'<br><b>PC1:</b>', round(PC1, 3),
'<br><b>PC2:</b>', round(PC2, 3),
'<br><b>Calidad:</b>', round(Cos2, 3)),
hoverinfo = 'text',
hoverlabel = list(
bgcolor = "white",
bordercolor = "black",
font = list(color = "black", size = 12)
)
) %>%
layout(
title = list(
text = "Análisis PCA - 182 Países (PC1 vs PC2)",
font = list(size = 16)
),
xaxis = list(
title = paste0("PC1 (", percent_pc1, "%)"),
gridcolor = "lightgray",
zeroline = TRUE,
zerolinecolor = "black",
zerolinewidth = 1
),
yaxis = list(
title = paste0("PC2 (", percent_pc2, "%)"),
gridcolor = "lightgray",
zeroline = TRUE,
zerolinecolor = "black",
zerolinewidth = 1
),
plot_bgcolor = "white",
paper_bgcolor = "white",
margin = list(l = 50, r = 50, b = 50, t = 50),
showlegend = FALSE
)
p3Gráfico Interactivo 1: PC1 vs PC2 variables
plot_var_12_interactive <- plot_ly() %>%
# Círculo de correlación
add_trace(
type = "scatter",
x = cos(seq(0, 2*pi, length.out = 100)),
y = sin(seq(0, 2*pi, length.out = 100)),
mode = "lines",
line = list(color = "#2E7D32", dash = "dash", width = 2),
hoverinfo = "none",
showlegend = FALSE,
name = "Círculo unidad"
) %>%
# Flechas de variables
add_annotations(
data = df_var_plot,
x = ~PC1,
y = ~PC2,
ax = 0,
ay = 0,
text = "",
showarrow = TRUE,
arrowhead = 2,
arrowsize = 1,
arrowwidth = 2.5,
arrowcolor = ~ifelse(Contrib_12 > 8, "#FC4E07",
ifelse(Contrib_12 > 5, "#E7B800", "#00AFBB")),
opacity = 0.85
) %>%
# Puntos de las variables
add_trace(
data = df_var_plot,
x = ~PC1,
y = ~PC2,
type = "scatter",
mode = "markers+text",
marker = list(
size = 12,
color = ~Contrib_12,
colorscale = list(
c(0, "#00AFBB"),
c(0.5, "#E7B800"),
c(1, "#FC4E07")
),
showscale = TRUE,
colorbar = list(
title = "Contribución<br>(%)",
thickness = 15,
len = 0.6,
x = 1.02
),
line = list(color = "white", width = 2)
),
text = ~Variable_corto,
textposition = "top center",
textfont = list(size = 10, color = "black", family = "Arial"),
hovertext = ~paste(
"<b>Variable:</b>", Variable_corto,
"<br><b>PC1:</b>", round(PC1, 3),
"<br><b>PC2:</b>", round(PC2, 3),
"<br><b>Contribución Total:</b>", round(Contrib_12, 2), "%",
"<br><b>Calidad (cos²):</b>", round(Cos2_PC1_PC2, 3)
),
hoverinfo = "text",
showlegend = FALSE
) %>%
layout(
title = list(
text = "<b>Círculo de Correlaciones - Variables PCA</b><br><sup>Dimensión 1 vs Dimensión 2</sup>",
x = 0.5,
font = list(size = 18, family = "Arial", color = "#2E7D32")
),
xaxis = list(
title = paste0("<b>Dim 1 (", percent_pc1, "%)</b>"),
range = c(-1.15, 1.15),
gridcolor = "lightgray",
zeroline = TRUE,
zerolinecolor = "gray50",
zerolinewidth = 1.5,
titlefont = list(size = 14)
),
yaxis = list(
title = paste0("<b>Dim 2 (", percent_pc2, "%)</b>"),
range = c(-1.15, 1.15),
gridcolor = "lightgray",
zeroline = TRUE,
zerolinecolor = "gray50",
zerolinewidth = 1.5,
scaleanchor = "x",
titlefont = list(size = 14)
),
plot_bgcolor = "white",
paper_bgcolor = "white",
font = list(family = "Arial"),
hoverlabel = list(
bgcolor = "white",
bordercolor = "black",
font = list(family = "Arial", size = 12)
),
margin = list(l = 80, r = 120, b = 80, t = 100)
)
plot_var_12_interactiveGráfico Interactivo 2: PC1 vs PC3
plot_var_13_interactive <- plot_ly() %>%
add_trace(
type = "scatter",
x = cos(seq(0, 2*pi, length.out = 100)),
y = sin(seq(0, 2*pi, length.out = 100)),
mode = "lines",
line = list(color = "#1565C0", dash = "dash", width = 2),
hoverinfo = "none",
showlegend = FALSE,
name = "Círculo unidad"
) %>%
add_annotations(
data = df_var_plot,
x = ~PC1,
y = ~PC3,
ax = 0,
ay = 0,
text = "",
showarrow = TRUE,
arrowhead = 2,
arrowsize = 1,
arrowwidth = 2.5,
arrowcolor = ~ifelse(Contrib_13 > 8, "#FC4E07",
ifelse(Contrib_13 > 5, "#E7B800", "#00AFBB")),
opacity = 0.85
) %>%
add_trace(
data = df_var_plot,
x = ~PC1,
y = ~PC3,
type = "scatter",
mode = "markers+text",
marker = list(
size = 12,
color = ~Contrib_13,
colorscale = list(
c(0, "#00AFBB"),
c(0.5, "#E7B800"),
c(1, "#FC4E07")
),
showscale = TRUE,
colorbar = list(
title = "Contribución<br>(%)",
thickness = 15,
len = 0.6,
x = 1.02
),
line = list(color = "white", width = 2)
),
text = ~Variable_corto,
textposition = "top center",
textfont = list(size = 10, color = "black", family = "Arial"),
hovertext = ~paste(
"<b>Variable:</b>", Variable_corto,
"<br><b>PC1:</b>", round(PC1, 3),
"<br><b>PC3:</b>", round(PC3, 3),
"<br><b>Contribución Total:</b>", round(Contrib_13, 2), "%",
"<br><b>Calidad (cos²):</b>", round(Cos2_PC1_PC3, 3)
),
hoverinfo = "text",
showlegend = FALSE
) %>%
layout(
title = list(
text = "<b>Círculo de Correlaciones - Variables PCA</b><br><sup>Dimensión 1 vs Dimensión 3</sup>",
x = 0.5,
font = list(size = 18, family = "Arial", color = "#1565C0")
),
xaxis = list(
title = paste0("<b>Dim 1 (", percent_pc1, "%)</b>"),
range = c(-1.15, 1.15),
gridcolor = "lightgray",
zeroline = TRUE,
zerolinecolor = "gray50",
zerolinewidth = 1.5,
titlefont = list(size = 14)
),
yaxis = list(
title = paste0("<b>Dim 3 (", percent_pc3, "%)</b>"),
range = c(-1.15, 1.15),
gridcolor = "lightgray",
zeroline = TRUE,
zerolinecolor = "gray50",
zerolinewidth = 1.5,
scaleanchor = "x",
titlefont = list(size = 14)
),
plot_bgcolor = "white",
paper_bgcolor = "white",
font = list(family = "Arial"),
hoverlabel = list(
bgcolor = "white",
bordercolor = "black",
font = list(family = "Arial", size = 12)
),
margin = list(l = 80, r = 120, b = 80, t = 100)
)
plot_var_13_interactiveResultados del ACP
##Valores Propios
eig.val <- get_eigenvalue(res.pca)
eig.val##Resultados para Variables
res.var <- get_pca_var(res.pca)
head(res.var$coord)
head(res.var$contrib)
head(res.var$cos2)
colSums(res.var$contrib[,1:2])Resultados para Países
res.ind <- get_pca_ind(res.pca)
head(res.ind$coord)
head(res.ind$contrib[,1:3])
head(res.ind$cos2)Tabla Interactiva de Contribuciones
verde_principal <- "#488B49"
color_scale <- function(values, color_low = "#FFFFFF", color_high = verde_principal) {
normalized <- (values - min(values)) / (max(values) - min(values))
colors <- colorRamp(c(color_low, color_high))(normalized)
rgb(colors[,1], colors[,2], colors[,3], maxColorValue = 255)
}
suitable_text_color <- function(hex_color) {
rgb <- col2rgb(hex_color)/255
luminance <- 0.299 * rgb[1] + 0.587 * rgb[2] + 0.114 * rgb[3]
if (luminance < 0.5) 'white' else '#2E7D32'
}
contribuciones_df <- data.frame(
País = rownames(res.ind$contrib),
PC1 = res.ind$contrib[,1],
PC2 = res.ind$contrib[,2],
PC3 = res.ind$contrib[,3],
row.names = NULL
)
contribuciones_df <- contribuciones_df[order(contribuciones_df$PC1, decreasing = TRUE), ]
pc1_colors <- color_scale(contribuciones_df$PC1)
pc2_colors <- color_scale(contribuciones_df$PC2)
pc3_colors <- color_scale(contribuciones_df$PC3)
tabla_contribuciones <- reactable(
contribuciones_df,
defaultPageSize = 15,
showPageSizeOptions = TRUE,
pageSizeOptions = c(10, 15, 25, 50),
filterable = TRUE,
searchable = TRUE,
sortable = TRUE,
resizable = FALSE,
striped = FALSE,
highlight = FALSE,
bordered = FALSE,
wrap = FALSE,
showSortIcon = TRUE,
theme = reactableTheme(
backgroundColor = "#ffffff",
borderColor = "#E8F5E8",
cellPadding = "6px 10px",
style = list(
fontFamily = "Segoe UI, Arial, sans-serif",
fontSize = "13px"
),
searchInputStyle = list(
width = "100%",
padding = "6px 10px",
border = paste("1px solid", "#81C784"),
borderRadius = "4px",
fontSize = "13px"
),
headerStyle = list(
borderBottom = paste("2px solid", "#2E7D32"),
fontSize = "13px",
backgroundColor = verde_principal,
color = "white",
fontWeight = "bold",
textTransform = "uppercase",
letterSpacing = "0.5px"
)
),
columns = list(
País = colDef(
name = "PAÍS",
minWidth = 180,
filterable = TRUE,
align = "left",
style = list(
fontWeight = "600",
color = "#2E7D32",
borderRight = paste("1px solid", "#E8F5E8")
)
),
PC1 = colDef(
name = "CONTRIBUCIÓN PC1",
minWidth = 140,
align = "center",
style = function(value, index) {
bg <- pc1_colors[index]
txt_color <- suitable_text_color(bg)
list(
background = bg,
fontWeight = "bold",
color = txt_color,
borderLeft = paste("1px solid", "#E8F5E8")
)
},
format = colFormat(digits = 3, percent = FALSE)
),
PC2 = colDef(
name = "CONTRIBUCIÓN PC2",
minWidth = 140,
align = "center",
style = function(value, index) {
bg <- pc2_colors[index]
txt_color <- suitable_text_color(bg)
list(
background = bg,
fontWeight = "bold",
color = txt_color,
borderLeft = paste("1px solid", "#E8F5E8")
)
},
format = colFormat(digits = 3, percent = FALSE)
),
PC3 = colDef(
name = "CONTRIBUCIÓN PC3",
minWidth = 140,
align = "center",
style = function(value, index) {
bg <- pc3_colors[index]
txt_color <- suitable_text_color(bg)
list(
background = bg,
fontWeight = "bold",
color = txt_color,
borderLeft = paste("1px solid", "#E8F5E8")
)
},
format = colFormat(digits = 3, percent = FALSE)
)
)
)
tabla_contribucionestop5_pc1 <- res.ind$contrib[,1, drop = FALSE] %>%
as.data.frame() %>%
arrange(desc(.[,1])) %>%
head(5) %>%
rename("Contribución (%)" = 1) %>%
mutate(País = rownames(.)) %>%
select(País, "Contribución (%)") %>%
mutate("Contribución (%)" = round(`Contribución (%)`, 3))
top5_pc1 %>%
kbl(align = c('l', 'c'),
caption = "Top 5 Países por Contribución al Componente Principal 1 (PC1)") %>%
kable_classic(full_width = FALSE,
html_font = "Cambria",
font_size = 14) %>%
row_spec(0, bold = TRUE, color = "white", background = "#2C3E50") %>%
row_spec(1:5, background = "#F8F9FA") %>%
column_spec(1, bold = TRUE) %>%
column_spec(2, width = "3cm") %>%
footnote(general = "La contribución representa el porcentaje de varianza explicado por cada país en el primer componente principal.",
general_title = "Nota:")| País | Contribución (%) | |
|---|---|---|
| Central African Republic | Central African Republic | 11.470 |
| Lesoto | Lesoto | 3.671 |
| Somalia | Somalia | 2.742 |
| Chad | Chad | 2.504 |
| Nigeria | Nigeria | 2.492 |
| Nota: | ||
| La contribución representa el porcentaje de varianza explicado por cada país en el primer componente principal. |
top5_pc2 <- res.ind$contrib[,2, drop = FALSE] %>%
as.data.frame() %>%
arrange(desc(.[,1])) %>%
head(5) %>%
rename("Contribución (%)" = 1) %>%
mutate(País = rownames(.)) %>%
select(País, "Contribución (%)") %>%
mutate("Contribución (%)" = round(`Contribución (%)`, 3))
top5_pc2 %>%
kbl(align = c('l', 'c'),
caption = "Top 5 Países por Contribución al Componente Principal 2 (PC2)") %>%
kable_classic(full_width = FALSE,
html_font = "Cambria",
font_size = 14) %>%
row_spec(0, bold = TRUE, color = "white", background = "#2C3E50") %>%
row_spec(1:5, background = "#F8F9FA") %>%
column_spec(1, bold = TRUE) %>%
column_spec(2, width = "3cm") %>%
footnote(general = "La contribución representa el porcentaje de varianza explicado por cada país en el segundo componente principal.",
general_title = "Nota:")| País | Contribución (%) | |
|---|---|---|
| Lesoto | Lesoto | 7.398 |
| Rusia | Rusia | 5.661 |
| Nigeria | Nigeria | 5.621 |
| Eswatini | Eswatini | 4.978 |
| India | India | 4.747 |
| Nota: | ||
| La contribución representa el porcentaje de varianza explicado por cada país en el segundo componente principal. |
top5_pc3 <- res.ind$contrib[,3, drop = FALSE] %>%
as.data.frame() %>%
arrange(desc(.[,1])) %>%
head(5) %>%
rename("Contribución (%)" = 1) %>%
mutate(País = rownames(.)) %>%
select(País, "Contribución (%)") %>%
mutate("Contribución (%)" = round(`Contribución (%)`, 3))
top5_pc3 %>%
kbl(align = c('l', 'c'),
caption = "Top 5 Países por Contribución al Componente Principal 3 (PC3)") %>%
kable_classic(full_width = FALSE,
html_font = "Cambria",
font_size = 14) %>%
row_spec(0, bold = TRUE, color = "white", background = "#2C3E50") %>%
row_spec(1:5, background = "#F8F9FA") %>%
column_spec(1, bold = TRUE) %>%
column_spec(2, width = "3cm") %>%
footnote(general = "La contribución representa el porcentaje de varianza explicado por cada país en el tercer componente principal.",
general_title = "Nota:")| País | Contribución (%) | |
|---|---|---|
| India | India | 51.160 |
| Pakistan | Pakistan | 10.416 |
| Nigeria | Nigeria | 9.727 |
| Corea del Sur | Corea del Sur | 1.512 |
| Congo, Dem. Rep. | Congo, Dem. Rep. | 1.143 |
| Nota: | ||
| La contribución representa el porcentaje de varianza explicado por cada país en el tercer componente principal. |
| Dimensión | Nombre Simplificado | Lo que Mide | Varianza | Variable Más Importante |
|---|---|---|---|---|
| Dim1 | Calidad de Salud | Desarrollo sanitario: esperanza de vida y mortalidad prevenible | 62.3% | Esperanza de vida (+) Mortalidad infantil (-) |
| Dim2 | Edad de Mortalidad | Mortalidad temprana versus adulta | 11.6% | Mortalidad temprana (+) Enfermedades crónicas (-) |
| Dim3 | Escala Poblacional | Efecto del tamaño poblacional en números absolutos de muertes | Pequeña | Muertes Neonatales (números absolutos) |
| Nota: | ||||
| Análisis de componentes principales aplicado a indicadores de salud global. Los signos (+) y (-) indican la dirección de la correlación. |
CLUSTER
Análisis de Componentes Principales
graphics.off()
par(mar = c(4, 4, 3, 2))
# Realizar ACP de forma no interactiva
acp_resultado <- dudi.pca(df = Muertes_df,
scannf = FALSE, # No mostrar gráfico de selección
nf = 3) # Número de ejes a retener
# Clustering no interactivo usando directamente los resultados del ACP
dist_matrix <- dist(acp_resultado$li[, 1:3]) # Distancia euclidiana en las 3 primeras componentes
hclust_result <- hclust(dist_matrix, method = "ward.D2")
clusters <- cutree(hclust_result, k = 2) # Cortar en 2 clusters
# Crear objeto similar a FactoClass
resultado_ACP <- list(
dudi = acp_resultado,
cluster = clusters,
hclust = hclust_result
)
NuevaBase <- data.frame(Cluster = resultado_ACP$cluster, Muertes_df)Preparación de Datos
# Extraer información del ACP para ggplot
acp_ind <- as.data.frame(resultado_ACP$dudi$li)
acp_var <- as.data.frame(resultado_ACP$dudi$co)
# Asignar nombres consistentes
colnames(acp_ind) <- paste0("Axis", 1:ncol(acp_ind))
colnames(acp_var) <- paste0("Axis", 1:ncol(acp_var))
acp_ind$Cluster <- as.factor(NuevaBase$Cluster)
acp_ind$Pais <- rownames(Muertes_df)
acp_var$Variable <- rownames(acp_var)
# Porcentaje de varianza explicada
eigenvals <- resultado_ACP$dudi$eig
var_exp <- round(eigenvals / sum(eigenvals) * 100, 2)Análisis Dendrograma
# Cargar librerías
library(plotly)
library(viridis)
library(ggdendro)##
## Adjuntando el paquete: 'ggdendro'## The following object is masked from 'package:xtable':
##
## label## The following object is masked from 'package:dendextend':
##
## theme_dendro# Función corregida con escala correcta del eje Y
crear_dendrograma_interactivo_mejorado <- function(hc) {
# Obtener la altura máxima REAL del objeto hclust
altura_max <- max(hc$height)
# Crear secuencia de alturas para el slider
alturas <- seq(0, altura_max, length.out = 20)
# Extraer datos del dendrograma para visualización
dend_data <- dendro_data(hc)
segmentos <- segment(dend_data)
# IMPORTANTE: Verificar que los valores Y corresponden a hc$height
# Los valores en segmentos$y y segmentos$yend ya deberían estar en la escala correcta
# Crear gráfico base con el dendrograma
fig <- plot_ly() %>%
add_segments(
data = segmentos,
x = ~x, xend = ~xend,
y = ~y, yend = ~yend,
line = list(color = "gray", width = 1),
hoverinfo = "none",
showlegend = FALSE
) %>%
layout(
title = "Dendrograma Interactivo con Línea de Corte",
xaxis = list(
title = "Países",
showticklabels = TRUE,
range = c(0.5, max(segmentos$xend) + 0.5)
),
yaxis = list(
title = "Distancia",
# Usar explícitamente la altura máxima de hc$height
range = c(0, altura_max * 1.05)
),
showlegend = FALSE,
hovermode = "closest"
)
# Agregar línea de corte inicial
fig <- fig %>% add_lines(
x = c(0.5, max(segmentos$xend) + 0.5),
y = c(alturas[1], alturas[1]),
line = list(color = "red", width = 3, dash = "dash"),
name = "Línea de corte",
hovertemplate = "Altura: %{y:.2f}<extra></extra>"
)
# Preparar steps para el slider
steps <- list()
# Obtener el número TOTAL de observaciones (países)
n_total <- length(hc$order) # Usar hc$order que es más confiable
cat("Número total de observaciones detectadas:", n_total, "\n")
for (i in 1:length(alturas)) {
altura_actual <- alturas[i]
# Calcular número de clusters a esta altura
if (i == 1) { # Primera posición del slider (altura mínima)
n_clusters <- n_total # Todos son clusters individuales
} else {
n_clusters <- length(unique(cutree(hc, h = altura_actual)))
}
step <- list(
method = "restyle",
args = list(
"y",
list(c(altura_actual, altura_actual)),
list(1) # Índice de la línea de corte
),
label = sprintf("%.2f (%d clusters)", altura_actual, n_clusters)
)
steps[[i]] <- step
}
# Configurar slider
fig <- fig %>% layout(
sliders = list(
list(
active = 0,
currentvalue = list(
prefix = "Altura de corte: ",
font = list(size = 14)
),
pad = list(t = 50, b = 10),
steps = steps
)
)
)
return(fig)
}
# EJECUTAR el código
# Verificar si existe hclust_result (el objeto real del análisis)
if(exists("hclust_result")) {
cat("=== DIAGNÓSTICO COMPLETO ===\n")
cat("Usando hclust_result (datos reales)\n")
cat("Número de observaciones (merge + 1):", nrow(as.matrix(hclust_result$merge)) + 1, "\n")
cat("Longitud de hclust_result$order:", length(hclust_result$order), "\n")
cat("Longitud de hclust_result$labels:", length(hclust_result$labels), "\n")
cat("Altura máxima del dendrograma:", max(hclust_result$height), "\n")
cat("Rango de alturas:", range(hclust_result$height), "\n")
# Verificar también Muertes_df si existe
if(exists("Muertes_df")) {
cat("Número de filas en Muertes_df:", nrow(Muertes_df), "\n")
}
dend_interactivo <- crear_dendrograma_interactivo_mejorado(hclust_result)
dend_interactivo
} else if(exists("hc")) {
cat("Usando hc\n")
cat("Altura máxima del dendrograma:", max(hc$height), "\n")
cat("Rango de alturas:", range(hc$height), "\n")
dend_interactivo <- crear_dendrograma_interactivo_mejorado(hc)
dend_interactivo
} else {
# Si ninguno existe, crear un ejemplo
cat("Creando un ejemplo con datos de iris...\n")
data <- scale(iris[, 1:4])
dist_matrix <- dist(data)
hc <- hclust(dist_matrix, method = "ward.D2")
cat("Altura máxima del dendrograma:", max(hc$height), "\n")
dend_interactivo <- crear_dendrograma_interactivo_mejorado(hc)
dend_interactivo
}## === DIAGNÓSTICO COMPLETO ===
## Usando hclust_result (datos reales)
## Número de observaciones (merge + 1): 182
## Longitud de hclust_result$order: 182
## Longitud de hclust_result$labels: 182
## Altura máxima del dendrograma: 57.005
## Rango de alturas: 0.06134435 57.005
## Número de filas en Muertes_df: 182
## Número total de observaciones detectadas: 182ANÁLISIS DE MÉTODO SILUETA PARA CLUSTERING JERÁRQUICO
# Configurar tema profesional CORREGIDO
theme_set(theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", hjust = 0.5, size = 16,
color = "#2C3E50"),
plot.subtitle = element_text(hjust = 0.5, size = 12, color = "#7F8C8D"),
panel.grid.major = element_line(color = "grey95"),
panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "white", color = NA),
plot.background = element_rect(fill = "white", color = NA),
axis.title = element_text(face = "bold", size = 12, color = "#2C3E50"),
axis.text = element_text(size = 10, color = "#34495E"),
axis.line = element_line(color = "#BDC3C7"),
legend.position = "none",
plot.margin = unit(c(1, 1, 1, 1), "cm") # CORRECCIÓN: margin correcta
))
# Usar las coordenadas del ACP
coordenadas_acp <- acp_resultado$li[, 1:3]
# Generar gráfico de silueta con colores atractivos
g_sil <- fviz_nbclust(
coordenadas_acp,
FUN = hcut,
method = "silhouette",
hc_method = "ward.D2",
hc_metric = "euclidean",
k.max = 10,
barfill = "#3498DB",
barcolor = "#2980B9",
linecolor = "#E74C3C",
ggtheme = theme_minimal()
) +
labs(
title = "ANÁLISIS DE SILUETA - DETERMINACIÓN DE CLÚSTERES ÓPTIMOS",
subtitle = "Clustering Jerárquico (Método Ward) aplicado a Componentes Principales",
x = "Número de Clústeres (k)",
y = "Anchura Promedio de Silueta"
) +
geom_bar(stat = "identity", alpha = 0.9, width = 0.7,
fill = "#3498DB", color = "#2980B9") +
geom_line(color = "#E74C3C", size = 1.5, alpha = 0.9)
# Obtener valores óptimos
optimo_clusters <- g_sil$data[which.max(g_sil$data$y), "clusters"]
max_silueta <- round(max(g_sil$data$y), 3)
# Ajustar límites
y_max <- max(g_sil$data$y) * 1.12
# Construir gráfico final CORREGIDO
g_sil_final <- g_sil +
geom_point(data = g_sil$data[which.max(g_sil$data$y),],
aes(x = clusters, y = y),
color = "#E74C3C", size = 6, shape = 21,
stroke = 2.5, fill = "white") +
geom_vline(
xintercept = optimo_clusters,
linetype = "dashed",
color = "#E74C3C",
size = 1.2,
alpha = 0.8
) +
annotate("text",
x = optimo_clusters,
y = y_max * 0.98,
label = paste("ÓPTIMO: k =", optimo_clusters),
color = "#2C3E50",
fontface = "bold",
size = 5.5,
hjust = 0.5) +
scale_y_continuous(limits = c(0, y_max),
breaks = seq(0, 0.5, by = 0.1)) +
theme(
panel.border = element_rect(color = "#BDC3C7", fill = NA, size = 1)
)
# Mostrar gráfico
print(g_sil_final)
# ============================================================================
# DEFINICIÓN DE COLORES GLOBALES PARA LOS CLUSTERS
# ============================================================================
verde_cluster1 <- "#488B49" # Verde para Cluster 1
azul_cluster2 <- "#4A90E2" # Azul para Cluster 2
colores_clusters <- c("1" = verde_cluster1, "2" = azul_cluster2)library(plotly)
library(factoextra)
library(viridis)
dist_matrix <- dist(resultado_ACP$dudi$li[, 1:3])
hc <- hclust(dist_matrix, method = "ward.D2")
paises <- rownames(resultado_ACP$dudi$li)
dendro_plot <- fviz_dend(hc, k = 2,
cex = 0.6,
k_colors = c(verde_cluster1, azul_cluster2),
color_labels_by_k = TRUE,
ggtheme = theme_minimal(),
main = "Dendrograma - Clasificación Jerárquica",
xlab = "Países", ylab = "Distancia")## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.plotly_dendro <- ggplotly(dendro_plot, tooltip = "all") %>%
layout(
title = list(
text = "<b>Dendrograma - Clasificación Jerárquica</b>",
x = 0.5,
font = list(size = 20, family = "Arial")
),
xaxis = list(
title = "<b>Países</b>",
tickfont = list(size = 10),
titlefont = list(size = 14),
showticklabels = FALSE
),
yaxis = list(
title = "<b>Distancia</b>",
titlefont = list(size = 14)
),
plot_bgcolor = "white",
paper_bgcolor = "white",
font = list(family = "Arial"),
hoverlabel = list(
bgcolor = "white",
bordercolor = "black",
font = list(family = "Arial", size = 12)
)
)
get_country_name <- function(position) {
if (position >= 1 && position <= length(paises)) {
return(paises[position])
}
return("N/A")
}
plotly_dendro <- plotly_dendro %>%
style(
hoverinfo = "text",
text = ~paste0(
"<b>País:</b> ", get_country_name(x), "<br>",
"<b>Distancia:</b> ", round(y, 4), "<br>",
"<b>Posición:</b> ", x
),
traces = c(1, 2)
)
plotly_dendroTabla Interactiva de Clusters por País
library(reactable)
library(reactablefmtr)
# 1. Paleta de colores para clusters
verde_cluster1 <- "#488B49" # Verde para Cluster 1
azul_cluster2 <- "#4A90E2" # Azul para Cluster 2
# 2. Crear dataframe con países y clusters
clusters_df <- data.frame(
País = rownames(Muertes_df),
Cluster = NuevaBase$Cluster,
row.names = NULL
)
# Ordenar por cluster y luego por país alfabéticamente
clusters_df <- clusters_df[order(clusters_df$Cluster, clusters_df$País), ]
# 3. Contar países por cluster
conteo_clusters <- table(clusters_df$Cluster)
clusters_df$Total_Cluster <- conteo_clusters[as.character(clusters_df$Cluster)]
# 4. Función para asignar color según cluster
get_cluster_color <- function(cluster) {
if (cluster == 1) return(verde_cluster1)
if (cluster == 2) return(azul_cluster2)
return("#808080") # Gris por defecto
}
# 5. Función para determinar color de texto adecuado
suitable_text_color <- function(hex_color) {
rgb <- col2rgb(hex_color)/255
luminance <- 0.299 * rgb[1] + 0.587 * rgb[2] + 0.114 * rgb[3]
if (luminance < 0.5) 'white' else '#2E3A3B'
}
# 6. Tabla reactable con diseño profesional
tabla_clusters <- reactable(
clusters_df,
defaultPageSize = 20,
showPageSizeOptions = TRUE,
pageSizeOptions = c(10, 20, 30, 50, nrow(clusters_df)),
filterable = TRUE,
searchable = TRUE,
sortable = TRUE,
resizable = FALSE,
striped = FALSE,
highlight = TRUE,
bordered = FALSE,
wrap = FALSE,
showSortIcon = TRUE,
defaultSorted = list(Cluster = "asc", País = "asc"),
theme = reactableTheme(
backgroundColor = "#ffffff",
borderColor = "#E8F5E8",
cellPadding = "8px 12px",
style = list(
fontFamily = "Segoe UI, Arial, sans-serif",
fontSize = "14px"
),
searchInputStyle = list(
width = "100%",
padding = "8px 12px",
border = "1px solid #81C784",
borderRadius = "4px",
fontSize = "14px"
),
headerStyle = list(
borderBottom = "2px solid #2E7D32",
fontSize = "14px",
backgroundColor = verde_cluster1,
color = "white",
fontWeight = "bold",
textTransform = "uppercase",
letterSpacing = "0.5px"
)
),
columns = list(
País = colDef(
name = "PAÍS",
minWidth = 200,
filterable = TRUE,
align = "left",
style = list(
fontWeight = "600",
color = "#2E3A3B",
borderRight = "1px solid #E8F5E8"
)
),
Cluster = colDef(
name = "CLUSTER",
minWidth = 120,
align = "center",
filterable = TRUE,
style = function(value) {
bg_color <- get_cluster_color(value)
txt_color <- suitable_text_color(bg_color)
list(
background = bg_color,
color = txt_color,
fontWeight = "bold",
fontSize = "15px",
borderRadius = "4px",
padding = "6px 12px",
borderLeft = "1px solid #E8F5E8"
)
},
cell = function(value) {
paste("Cluster", value)
}
),
Total_Cluster = colDef(
name = "TOTAL EN CLUSTER",
minWidth = 140,
align = "center",
filterable = FALSE,
style = function(value, index) {
cluster_actual <- clusters_df$Cluster[index]
bg_color <- get_cluster_color(cluster_actual)
# Crear un color más claro para el background
rgb_vals <- col2rgb(bg_color)
light_bg <- rgb(rgb_vals[1], rgb_vals[2], rgb_vals[3],
alpha = 50, maxColorValue = 255)
list(
background = light_bg,
color = bg_color,
fontWeight = "600",
fontSize = "14px",
borderLeft = "1px solid #E8F5E8"
)
},
cell = function(value) {
paste(value, "países")
}
)
)
)
# Mostrar la tabla
tabla_clustersPreparación de datos para Biplot
# Crear circle_data con las coordenadas de las variables
circle_data <- data.frame(
Variable = rownames(acp_var),
Axis1 = acp_var$Axis1,
Axis2 = acp_var$Axis2,
Axis3 = acp_var$Axis3
)
# Aplicar nombres cortos a las variables
circle_data$Variable_corto <- nombres_cortos_var[circle_data$Variable]
# Si no hay nombre corto disponible, usar el original
circle_data$Variable_corto[is.na(circle_data$Variable_corto)] <-
circle_data$Variable[is.na(circle_data$Variable_corto)]Biplot Interactivo
# Preparar anotaciones de flechas
anotaciones_flechas <- lapply(1:nrow(circle_data), function(i) {
list(
x = circle_data$Axis1[i] * 3,
y = circle_data$Axis2[i] * 3,
ax = 0,
ay = 0,
xref = "x",
yref = "y",
axref = "x",
ayref = "y",
text = "",
showarrow = TRUE,
arrowhead = 4,
arrowsize = 0.8,
arrowwidth = 1.5,
arrowcolor = "rgba(228,26,28,0.8)"
)
})
# Obtener clusters únicos
clusters <- unique(acp_ind$Cluster)
# Crear el gráfico base
plotly_biplot <- plot_ly()
# Agregar puntos por cluster
for(cluster in clusters) {
datos_cluster <- acp_ind[acp_ind$Cluster == cluster, ]
color_cluster <- colores_clusters[as.character(cluster)]
plotly_biplot <- plotly_biplot %>%
add_trace(data = datos_cluster,
x = ~Axis1, y = ~Axis2,
type = "scatter",
mode = "markers",
marker = list(size = 9, opacity = 0.7,
line = list(width = 1, color = 'darkgray'),
color = color_cluster),
name = paste("Cluster", cluster),
text = ~paste("<b>País:</b>", Pais,
"<br><b>Cluster:</b>", Cluster,
"<br><b>Comp. 1:</b>", round(Axis1, 2),
"<br><b>Comp. 2:</b>", round(Axis2, 2)),
hoverinfo = "text",
showlegend = TRUE,
legendgroup = "paises")
}
# Agregar las variables (flechas y etiquetas)
plotly_biplot <- plotly_biplot %>%
add_trace(data = circle_data,
x = ~Axis1*3, y = ~Axis2*3,
text = ~Variable_corto,
type = "scatter",
mode = "text",
textfont = list(color = "#E41A1C", size = 11,
family = "Arial", weight = "bold"),
name = "Variables",
hoverinfo = "text",
hovertext = ~paste("<b>Variable:</b>", Variable_corto,
"<br><b>Comp. 1:</b>", round(Axis1, 3),
"<br><b>Comp. 2:</b>", round(Axis2, 3)),
showlegend = TRUE,
legendgroup = "variables")
# Preparar vectores de visibilidad para los botones
n_clusters <- length(clusters)
visible_solo_paises <- c(rep(TRUE, n_clusters), FALSE)
visible_solo_variables <- c(rep(FALSE, n_clusters), TRUE)
visible_ambos <- rep(TRUE, n_clusters + 1)
# Configurar el layout con botones
plotly_biplot <- plotly_biplot %>%
layout(
title = list(
text = "<b>Biplot - Análisis de Componentes Principales</b>",
x = 0.05,
font = list(size = 18, family = "Arial")
),
xaxis = list(
title = paste0("<b>Dimensión 1 (", var_exp[1], "%)</b>"),
gridcolor = 'lightgray',
zerolinecolor = 'gray',
zerolinewidth = 2
),
yaxis = list(
title = paste0("<b>Dimensión 2 (", var_exp[2], "%)</b>"),
gridcolor = 'lightgray',
zerolinecolor = 'gray',
zerolinewidth = 2
),
plot_bgcolor = 'white',
paper_bgcolor = 'white',
font = list(family = "Arial"),
hoverlabel = list(
bgcolor = "white",
bordercolor = "black",
font = list(family = "Arial", size = 12)
),
legend = list(
orientation = "v",
x = 0.02,
y = 0.98,
bgcolor = 'rgba(255,255,255,0.9)',
bordercolor = 'gray',
borderwidth = 1
),
annotations = anotaciones_flechas,
updatemenus = list(
list(
type = "buttons",
direction = "right",
x = 0.8,
xanchor = "center",
y = 1.12,
yanchor = "top",
bgcolor = "#F5F5F5",
bordercolor = "#CCCCCC",
borderwidth = 1,
buttons = list(
list(
method = "update",
args = list(
list(visible = as.list(visible_solo_paises)),
list(annotations = list())
),
label = "Solo Países"
),
list(
method = "update",
args = list(
list(visible = as.list(visible_solo_variables)),
list(annotations = anotaciones_flechas)
),
label = "Solo Variables"
),
list(
method = "update",
args = list(
list(visible = as.list(visible_ambos)),
list(annotations = anotaciones_flechas)
),
label = "Ambos"
)
)
)
)
)
# Mostrar el gráfico
plotly_biplotlibrary(dplyr)
library(tidyr)
library(gt)##
## Adjuntando el paquete: 'gt'## The following objects are masked from 'package:reactablefmtr':
##
## google_font, htmllibrary(stringr)
# Diccionario de nombres descriptivos para las variables
nombres_variables <- c(
"Expectativa_de_vida_mujer" = "Esperanza de vida - Mujeres",
"Expectativa_de_vida_hombres" = "Esperanza de vida - Hombres",
"Accidentes_de_transito" = "Muertes por accidentes de tránsito",
"Enfermedades_cardiacas_cancer_diabetes_mujeres" = "Enf. crónicas - Mujeres",
"Enfermedades_cardiacas_cancer_diabetes_hombres" = "Enf. crónicas - Hombres",
"Polucion_del_aire_mujeres" = "Muertes por polución - Mujeres",
"Polucion_del_aire_hombres" = "Muertes por polución - Hombres",
"Envenenamiento_accidental_mujeres" = "Envenenamiento - Mujeres",
"Envenenamiento_accidental_hombres" = "Envenenamiento - Hombres",
"Tasa_de_mortalidad_mujeres_adultas" = "Mortalidad adulta - Mujeres",
"Tasa_de_mortalidad_hombres_adultos" = "Mortalidad adulta - Hombres",
"Tasa_de_mortalidad_infantil_mujeres" = "Mortalidad infantil - Mujeres",
"Tasa_de_mortalidad_infantil_varones" = "Mortalidad infantil - Hombres",
"Tasa_de_mortalidad_neonatal" = "Mortalidad neonatal",
"Tasa_de_mortalidad_infantil_temprana_mujeres" = "Mortalidad temprana - Mujeres",
"Tasa_de_mortalidad_infantil_temprana_hombres" = "Mortalidad temprana - Hombres",
"Numero_de_muertes_infantiles" = "Número de muertes infantiles",
"Numero_de_muertes_neonatales" = "Número de muertes neonatales",
"Tasa_de_suicidios_mujeres" = "Tasa de suicidios - Mujeres",
"Tasa_de_suicidios_hombres" = "Tasa de suicidios - Hombres",
"Supervivencia_hasta_los_65_anos_mujeres" = "Supervivencia a 65 años - Mujeres",
"Supervivencia_hasta_los_65_anos_hombres" = "Supervivencia a 65 años - Hombres"
)
# Calcular estadísticas descriptivas por cluster
estadisticas_clusters <- NuevaBase %>%
group_by(Cluster) %>%
summarise(across(
where(is.numeric),
list(
Media = ~mean(., na.rm = TRUE),
Mediana = ~median(., na.rm = TRUE),
DE = ~sd(., na.rm = TRUE),
Min = ~min(., na.rm = TRUE),
Max = ~max(., na.rm = TRUE)
),
.names = "{.col}_{.fn}"
)) %>%
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) %>%
pivot_wider(
names_from = Estadistica,
values_from = Valor
)
# Crear tabla con formato profesional
tabla_estadisticas <- estadisticas_clusters %>%
mutate(
Variable_Descriptiva = nombres_variables[Variable],
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("**ESTADÍSTICAS DESCRIPTIVAS POR CLUSTER**"),
subtitle = "Análisis de Indicadores de Mortalidad Global"
) %>%
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
) %>%
tab_style(
style = list(
cell_text(weight = "bold", size = "medium"),
cell_fill(color = "white")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_borders(
sides = c("top", "bottom"),
color = "black",
weight = px(1)
),
locations = list(
cells_column_labels(),
cells_body()
)
) %>%
tab_style(
style = cell_borders(
sides = "right",
color = "gray80",
weight = px(1)
),
locations = cells_body(columns = c(Variable_Descriptiva, Media, Mediana, DE, Min))
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = Variable_Descriptiva)
) %>%
tab_style(
style = cell_fill(color = "#E8F5E8"),
locations = cells_row_groups()
) %>%
tab_options(
table.font.names = "Times New Roman",
table.width = pct(100),
table.border.top.style = "none",
table.border.bottom.style = "none",
column_labels.border.top.style = "none",
column_labels.border.bottom.width = px(2),
column_labels.border.bottom.color = "black",
table_body.border.bottom.style = "none",
table_body.border.top.style = "none",
data_row.padding = px(6),
heading.title.font.size = 16,
heading.subtitle.font.size = 14,
heading.padding = px(8),
footnotes.padding = px(6)
) %>%
tab_source_note(
source_note = md("**Fuente:** Elaboración propia con base en datos de mortalidad global")
)
tabla_estadisticas| ESTADÍSTICAS DESCRIPTIVAS POR CLUSTER | |||||
| Análisis de Indicadores de Mortalidad Global | |||||
| Variable | Media | Mediana | D.E. | Mín | Máx |
|---|---|---|---|---|---|
| Cluster 1 | |||||
| Enf. crónicas - Hombres | 0.50 | 0.40 | 0.71 | −0.75 | 2.47 |
| Enf. crónicas - Mujeres | 0.87 | 0.75 | 0.65 | −0.11 | 2.57 |
| Envenenamiento - Hombres | 0.40 | 0.32 | 0.87 | −0.88 | 2.97 |
| Envenenamiento - Mujeres | 0.62 | 0.52 | 1.06 | −0.86 | 4.24 |
| Esperanza de vida - Hombres | −1.09 | −1.01 | 0.74 | −5.38 | 0.03 |
| Esperanza de vida - Mujeres | −1.16 | −1.08 | 0.71 | −4.44 | 0.20 |
| Mortalidad adulta - Hombres | 0.97 | 0.79 | 0.94 | −0.13 | 6.53 |
| Mortalidad adulta - Mujeres | 1.11 | 0.99 | 0.91 | −0.24 | 5.33 |
| Mortalidad infantil - Hombres | 1.20 | 1.11 | 0.84 | −0.51 | 4.92 |
| Mortalidad infantil - Mujeres | 1.19 | 1.03 | 0.89 | −0.52 | 5.34 |
| Mortalidad neonatal | 1.25 | 1.18 | 0.64 | −0.46 | 2.67 |
| Mortalidad temprana - Hombres | 1.13 | 0.84 | 1.04 | −0.38 | 6.37 |
| Mortalidad temprana - Mujeres | 1.09 | 0.76 | 1.11 | −0.38 | 6.85 |
| Muertes por accidentes de tránsito | 0.92 | 0.97 | 0.81 | −0.48 | 4.39 |
| Muertes por polución - Hombres | 0.98 | 1.02 | 0.63 | −0.78 | 2.72 |
| Muertes por polución - Mujeres | 1.05 | 1.10 | 0.64 | −0.74 | 2.56 |
| Número de muertes infantiles | 0.47 | 0.00 | 1.66 | −0.30 | 9.61 |
| Número de muertes neonatales | 0.44 | −0.02 | 1.67 | −0.28 | 10.23 |
| Supervivencia a 65 años - Hombres | −1.06 | −0.98 | 0.71 | −4.82 | 0.12 |
| Supervivencia a 65 años - Mujeres | −1.16 | −1.07 | 0.79 | −4.70 | 0.20 |
| Tasa de suicidios - Hombres | −0.29 | −0.41 | 0.75 | −1.23 | 3.41 |
| Tasa de suicidios - Mujeres | −0.11 | −0.28 | 0.87 | −1.24 | 4.08 |
| Cluster 2 | |||||
| Enf. crónicas - Hombres | −0.23 | −0.38 | 1.03 | −1.60 | 3.07 |
| Enf. crónicas - Mujeres | −0.41 | −0.49 | 0.86 | −1.73 | 2.51 |
| Envenenamiento - Hombres | −0.19 | −0.53 | 1.00 | −1.03 | 5.50 |
| Envenenamiento - Mujeres | −0.29 | −0.56 | 0.83 | −0.92 | 4.22 |
| Esperanza de vida - Hombres | 0.51 | 0.49 | 0.62 | −0.86 | 1.56 |
| Esperanza de vida - Mujeres | 0.54 | 0.58 | 0.55 | −0.90 | 1.56 |
| Mortalidad adulta - Hombres | −0.45 | −0.50 | 0.64 | −1.53 | 1.40 |
| Mortalidad adulta - Mujeres | −0.52 | −0.60 | 0.48 | −1.27 | 1.29 |
| Mortalidad infantil - Hombres | −0.56 | −0.66 | 0.38 | −1.00 | 1.05 |
| Mortalidad infantil - Mujeres | −0.55 | −0.65 | 0.37 | −0.97 | 1.01 |
| Mortalidad neonatal | −0.58 | −0.73 | 0.45 | −1.15 | 1.00 |
| Mortalidad temprana - Hombres | −0.53 | −0.59 | 0.30 | −0.85 | 0.95 |
| Mortalidad temprana - Mujeres | −0.51 | −0.58 | 0.28 | −0.81 | 0.90 |
| Muertes por accidentes de tránsito | −0.43 | −0.54 | 0.77 | −1.58 | 2.02 |
| Muertes por polución - Hombres | −0.46 | −0.70 | 0.79 | −1.20 | 2.28 |
| Muertes por polución - Mujeres | −0.49 | −0.74 | 0.72 | −1.17 | 2.18 |
| Número de muertes infantiles | −0.22 | −0.29 | 0.21 | −0.30 | 0.93 |
| Número de muertes neonatales | −0.21 | −0.27 | 0.20 | −0.28 | 1.02 |
| Supervivencia a 65 años - Hombres | 0.49 | 0.51 | 0.68 | −1.25 | 1.70 |
| Supervivencia a 65 años - Mujeres | 0.54 | 0.60 | 0.49 | −1.04 | 1.32 |
| Tasa de suicidios - Hombres | 0.14 | −0.04 | 1.07 | −1.36 | 3.21 |
| Tasa de suicidios - Mujeres | 0.05 | −0.13 | 1.06 | −1.38 | 4.08 |
| Fuente: Elaboración propia con base en datos de mortalidad global | |||||
# Tabla comparativa de medias entre clusters
tabla_comparativa <- estadisticas_clusters %>%
filter(!is.na(Media)) %>%
mutate(
Variable_Descriptiva = nombres_variables[Variable],
Cluster = paste("Cluster", Cluster),
Media = round(Media, 2)
) %>%
select(Cluster, Variable_Descriptiva, Media) %>%
pivot_wider(
names_from = Cluster,
values_from = Media
) %>%
arrange(Variable_Descriptiva) %>%
gt() %>%
tab_header(
title = md("**COMPARACIÓN DE CLUSTERS - MEDIAS POR VARIABLE**"),
subtitle = "Análisis comparativo de indicadores de mortalidad entre clusters"
) %>%
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
) %>%
data_color(
columns = -Variable_Descriptiva,
colors = scales::col_numeric(
palette = c("#FFC0CB", "#FFFFFF", "#90EE90"),
domain = NULL
)
) %>%
tab_style(
style = list(
cell_text(weight = "bold", size = "medium"),
cell_fill(color = "white")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_borders(
sides = c("top", "bottom"),
color = "black",
weight = px(1)
),
locations = list(
cells_column_labels(),
cells_body()
)
) %>%
tab_style(
style = cell_borders(
sides = "right",
color = "gray80",
weight = px(1)
),
locations = cells_body(columns = Variable_Descriptiva)
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = Variable_Descriptiva)
) %>%
tab_options(
table.font.names = "Times New Roman",
table.width = pct(100),
table.border.top.style = "none",
table.border.bottom.style = "none",
column_labels.border.top.style = "none",
column_labels.border.bottom.width = px(2),
column_labels.border.bottom.color = "black",
table_body.border.bottom.style = "none",
table_body.border.top.style = "none",
data_row.padding = px(6),
heading.title.font.size = 16,
heading.subtitle.font.size = 14,
heading.padding = px(8)
) %>%
tab_source_note(
source_note = md("**Nota:** Los colores indican valores relativos - verde para valores altos, rosa para valores bajos")
)## Warning: Since gt v0.9.0, the `colors` argument has been deprecated.
## • Please use the `fn` argument instead.
## This warning is displayed once every 8 hours.tabla_comparativa| COMPARACIÓN DE CLUSTERS - MEDIAS POR VARIABLE | ||
| Análisis comparativo de indicadores de mortalidad entre clusters | ||
| Variable | Cluster 1 | Cluster 2 |
|---|---|---|
| Enf. crónicas - Hombres | 0.50 | −0.23 |
| Enf. crónicas - Mujeres | 0.87 | −0.41 |
| Envenenamiento - Hombres | 0.40 | −0.19 |
| Envenenamiento - Mujeres | 0.62 | −0.29 |
| Esperanza de vida - Hombres | −1.09 | 0.51 |
| Esperanza de vida - Mujeres | −1.16 | 0.54 |
| Mortalidad adulta - Hombres | 0.97 | −0.45 |
| Mortalidad adulta - Mujeres | 1.11 | −0.52 |
| Mortalidad infantil - Hombres | 1.20 | −0.56 |
| Mortalidad infantil - Mujeres | 1.19 | −0.55 |
| Mortalidad neonatal | 1.25 | −0.58 |
| Mortalidad temprana - Hombres | 1.13 | −0.53 |
| Mortalidad temprana - Mujeres | 1.09 | −0.51 |
| Muertes por accidentes de tránsito | 0.92 | −0.43 |
| Muertes por polución - Hombres | 0.98 | −0.46 |
| Muertes por polución - Mujeres | 1.05 | −0.49 |
| Número de muertes infantiles | 0.47 | −0.22 |
| Número de muertes neonatales | 0.44 | −0.21 |
| Supervivencia a 65 años - Hombres | −1.06 | 0.49 |
| Supervivencia a 65 años - Mujeres | −1.16 | 0.54 |
| Tasa de suicidios - Hombres | −0.29 | 0.14 |
| Tasa de suicidios - Mujeres | −0.11 | 0.05 |
| Nota: Los colores indican valores relativos - verde para valores altos, rosa para valores bajos | ||
# Resumen general de los clusters
resumen_clusters <- NuevaBase %>%
group_by(Cluster) %>%
summarise(
`Número de Países` = n(),
`Esperanza Vida (Media)` = round(mean(Expectativa_de_vida_mujer, na.rm = TRUE), 1),
`Mortalidad Infantil (Media)` = round(mean(Tasa_de_mortalidad_infantil_mujeres, na.rm = TRUE), 1),
`Mortalidad Adulta (Media)` = round(mean(Tasa_de_mortalidad_mujeres_adultas, na.rm = TRUE), 1),
`Supervivencia 65 años (Media)` = round(mean(Supervivencia_hasta_los_65_anos_mujeres, na.rm = TRUE), 1)
) %>%
mutate(Cluster = paste("Cluster", Cluster))
tabla_resumen <- resumen_clusters %>%
gt() %>%
tab_header(
title = md("**RESUMEN GENERAL POR CLUSTER**"),
subtitle = "Indicadores clave de mortalidad y salud"
) %>%
cols_align(
align = "center",
columns = -Cluster
) %>%
cols_align(
align = "left",
columns = Cluster
) %>%
tab_style(
style = list(
cell_text(weight = "bold"),
cell_fill(color = "#488B49", alpha = 0.8),
cell_text(color = "white")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = Cluster)
) %>%
tab_style(
style = cell_fill(color = "#F8F9FA"),
locations = cells_body()
) %>%
tab_options(
table.font.names = "Times New Roman",
table.width = pct(100),
heading.title.font.size = 16,
heading.subtitle.font.size = 14,
data_row.padding = px(8)
)
tabla_resumen| RESUMEN GENERAL POR CLUSTER | |||||
| Indicadores clave de mortalidad y salud | |||||
| Cluster | Número de Países | Esperanza Vida (Media) | Mortalidad Infantil (Media) | Mortalidad Adulta (Media) | Supervivencia 65 años (Media) |
|---|---|---|---|---|---|
| Cluster 1 | 58 | -1.2 | 1.2 | 1.1 | -1.2 |
| Cluster 2 | 124 | 0.5 | -0.6 | -0.5 | 0.5 |
Gráfico PC1 vs PC2 - Clusters
library(ggplot2)
library(ggforce)
library(dplyr)
# Preparar datos para el gráfico
df_clusters <- data.frame(
Pais = rownames(resultado_ACP$dudi$li),
PC1 = resultado_ACP$dudi$li[, 1],
PC2 = resultado_ACP$dudi$li[, 2],
PC3 = resultado_ACP$dudi$li[, 3],
Cluster = as.factor(NuevaBase$Cluster)
)
# Calcular centroides de cada cluster
centroides_12 <- df_clusters %>%
group_by(Cluster) %>%
summarise(
PC1_centro = mean(PC1),
PC2_centro = mean(PC2),
.groups = 'drop'
)
# Definir colores profesionales para los clusters
colores_clusters <- c("#2E7D32", "#1565C0") # Verde oscuro y azul oscuro
# Crear gráfico estático PC1 vs PC2 con elipses
plot_clusters_12 <- ggplot(df_clusters, aes(x = PC1, y = PC2, color = Cluster, fill = Cluster)) +
# Elipses de confianza (95%)
stat_ellipse(geom = "polygon", alpha = 0.2, level = 0.95, linewidth = 1.5) +
# Puntos de los países
geom_point(size = 3.5, alpha = 0.8, stroke = 1, shape = 21, color = "white") +
# Centroides
geom_point(data = centroides_12,
aes(x = PC1_centro, y = PC2_centro, color = Cluster),
size = 10, shape = 4, stroke = 3, show.legend = FALSE) +
# Etiquetas de centroides
geom_text(data = centroides_12,
aes(x = PC1_centro, y = PC2_centro, label = paste("Centroide", Cluster)),
vjust = -1.5, size = 5, fontface = "bold", show.legend = FALSE) +
# Líneas en cero
geom_hline(yintercept = 0, linetype = "dashed", color = "gray40", linewidth = 0.5) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray40", linewidth = 0.5) +
# Escalas de color
scale_color_manual(values = colores_clusters, name = "Cluster") +
scale_fill_manual(values = colores_clusters, name = "Cluster") +
# Etiquetas y título
labs(
title = "Análisis de Clusters - Dimensiones Principales 1 y 2",
subtitle = "Elipses de confianza al 95% con centroides",
x = paste0("Dimensión Principal 1 (", var_exp[1], "%)"),
y = paste0("Dimensión Principal 2 (", var_exp[2], "%)")
) +
# Tema
theme_minimal(base_size = 14) +
theme(
plot.title = element_text(face = "bold", size = 18, hjust = 0.5, color = "#2E7D32"),
plot.subtitle = element_text(face = "italic", size = 12, hjust = 0.5, color = "gray40"),
axis.title = element_text(face = "bold", size = 14),
axis.text = element_text(size = 12),
legend.position = "right",
legend.title = element_text(face = "bold", size = 13),
legend.text = element_text(size = 12),
legend.background = element_rect(fill = "white", color = "#2E7D32", linewidth = 1),
legend.key.size = unit(1, "cm"),
panel.grid.major = element_line(color = "gray90"),
panel.grid.minor = element_line(color = "gray95"),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
)
print(plot_clusters_12)
Gráfico PC1 vs PC3 - Clusters
# Calcular centroides para PC1 y PC3
centroides_13 <- df_clusters %>%
group_by(Cluster) %>%
summarise(
PC1_centro = mean(PC1),
PC3_centro = mean(PC3),
.groups = 'drop'
)
# Crear gráfico estático PC1 vs PC3 con elipses
plot_clusters_13 <- ggplot(df_clusters, aes(x = PC1, y = PC3, color = Cluster, fill = Cluster)) +
# Elipses de confianza (95%)
stat_ellipse(geom = "polygon", alpha = 0.2, level = 0.95, linewidth = 1.5) +
# Puntos de los países
geom_point(size = 3.5, alpha = 0.8, stroke = 1, shape = 21, color = "white") +
# Centroides
geom_point(data = centroides_13,
aes(x = PC1_centro, y = PC3_centro, color = Cluster),
size = 10, shape = 4, stroke = 3, show.legend = FALSE) +
# Etiquetas de centroides
geom_text(data = centroides_13,
aes(x = PC1_centro, y = PC3_centro, label = paste("Centroide", Cluster)),
vjust = -1.5, size = 5, fontface = "bold", show.legend = FALSE) +
# Líneas en cero
geom_hline(yintercept = 0, linetype = "dashed", color = "gray40", linewidth = 0.5) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray40", linewidth = 0.5) +
# Escalas de color
scale_color_manual(values = colores_clusters, name = "Cluster") +
scale_fill_manual(values = colores_clusters, name = "Cluster") +
# Etiquetas y título
labs(
title = "Análisis de Clusters - Dimensión Principales 1 y 3",
subtitle = "Elipses de confianza al 95% con centroides",
x = paste0("Dimensión Principal 1 (", var_exp[1], "%)"),
y = paste0("Dimensión Principal 3 (", var_exp[3], "%)")
) +
# Tema
theme_minimal(base_size = 14) +
theme(
plot.title = element_text(face = "bold", size = 18, hjust = 0.5, color = "#2E7D32"),
plot.subtitle = element_text(face = "italic", size = 12, hjust = 0.5, color = "gray40"),
axis.title = element_text(face = "bold", size = 14),
axis.text = element_text(size = 12),
legend.position = "right",
legend.title = element_text(face = "bold", size = 13),
legend.text = element_text(size = 12),
legend.background = element_rect(fill = "white", color = "#2E7D32", linewidth = 1),
legend.key.size = unit(1, "cm"),
panel.grid.major = element_line(color = "gray90"),
panel.grid.minor = element_line(color = "gray95"),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
)
print(plot_clusters_13)
# Resumen general de los clusters
resumen_clusters <- NuevaBase %>%
group_by(Cluster) %>%
summarise(
`Número de Países` = n(),
`Esperanza Vida (Media)` = round(mean(Expectativa_de_vida_mujer, na.rm = TRUE), 1),
`Mortalidad Infantil (Media)` = round(mean(Tasa_de_mortalidad_infantil_mujeres, na.rm = TRUE), 1),
`Mortalidad Adulta (Media)` = round(mean(Tasa_de_mortalidad_mujeres_adultas, na.rm = TRUE), 1),
`Supervivencia 65 años (Media)` = round(mean(Supervivencia_hasta_los_65_anos_mujeres, na.rm = TRUE), 1)
) %>%
mutate(Cluster = paste("Cluster", Cluster))
tabla_resumen <- resumen_clusters %>%
gt() %>%
tab_header(
title = md("**RESUMEN GENERAL POR CLUSTER**"),
subtitle = "Indicadores clave de mortalidad y salud"
) %>%
cols_align(
align = "center",
columns = -Cluster
) %>%
cols_align(
align = "left",
columns = Cluster
) %>%
tab_style(
style = list(
cell_text(weight = "bold"),
cell_fill(color = "#488B49", alpha = 0.8),
cell_text(color = "white")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = Cluster)
) %>%
tab_style(
style = cell_fill(color = "#F8F9FA"),
locations = cells_body()
) %>%
tab_options(
table.font.names = "Times New Roman",
table.width = pct(100),
heading.title.font.size = 16,
heading.subtitle.font.size = 14,
data_row.padding = px(8)
)
tabla_resumen| RESUMEN GENERAL POR CLUSTER | |||||
| Indicadores clave de mortalidad y salud | |||||
| Cluster | Número de Países | Esperanza Vida (Media) | Mortalidad Infantil (Media) | Mortalidad Adulta (Media) | Supervivencia 65 años (Media) |
|---|---|---|---|---|---|
| Cluster 1 | 58 | -1.2 | 1.2 | 1.1 | -1.2 |
| Cluster 2 | 124 | 0.5 | -0.6 | -0.5 | 0.5 |
Mapa Geográfico de Clusters
library(rnaturalearth)
library(rnaturalearthdata)
library(leaflet)
library(sf)
library(countrycode)
# Obtener mapa mundial
world <- ne_countries(scale = "medium", returnclass = "sf")
# Crear base con clusters y códigos de país
Base_clusters <- data.frame(
Pais = rownames(Muertes_df),
Cluster = NuevaBase$Cluster
)
# Diccionario completo de traducción español -> inglés
traduccion_paises <- c(
"Alemania" = "Germany", "Arabia Saudita" = "Saudi Arabia", "Argelia" = "Algeria",
"Argentina" = "Argentina", "Australia" = "Australia", "Austria" = "Austria",
"Belgica" = "Belgium", "Bolivia" = "Bolivia", "Brasil" = "Brazil",
"Canada" = "Canada", "Chile" = "Chile", "China" = "China",
"Colombia" = "Colombia", "Corea del Sur" = "South Korea", "Corea del Norte" = "North Korea",
"Costa Rica" = "Costa Rica", "Croacia" = "Croatia", "Cuba" = "Cuba",
"Dinamarca" = "Denmark", "Ecuador" = "Ecuador", "Egipto" = "Egypt",
"El Salvador" = "El Salvador", "Emiratos Arabes Unidos" = "United Arab Emirates",
"Eslovaquia" = "Slovakia", "Eslovenia" = "Slovenia", "Espana" = "Spain",
"Estados Unidos" = "United States", "Estonia" = "Estonia", "Etiopia" = "Ethiopia",
"Filipinas" = "Philippines", "Finlandia" = "Finland", "Francia" = "France",
"Georgia" = "Georgia", "Ghana" = "Ghana", "Grecia" = "Greece",
"Guatemala" = "Guatemala", "Haiti" = "Haiti", "Honduras" = "Honduras",
"Hong Kong" = "Hong Kong", "Hungria" = "Hungary", "India" = "India",
"Indonesia" = "Indonesia", "Iran" = "Iran", "Irak" = "Iraq",
"Irlanda" = "Ireland", "Islandia" = "Iceland", "Israel" = "Israel",
"Italia" = "Italy", "Jamaica" = "Jamaica", "Japon" = "Japan",
"Jordania" = "Jordan", "Kazajistan" = "Kazakhstan", "Kenia" = "Kenya",
"Kuwait" = "Kuwait", "Letonia" = "Latvia", "Libano" = "Lebanon",
"Libia" = "Libya", "Lituania" = "Lithuania", "Luxemburgo" = "Luxembourg",
"Malasia" = "Malaysia", "Maldivas" = "Maldives", "Mali" = "Mali",
"Malta" = "Malta", "Marruecos" = "Morocco", "Mauricio" = "Mauritius",
"Mexico" = "Mexico", "Moldavia" = "Moldova", "Monaco" = "Monaco",
"Mongolia" = "Mongolia", "Montenegro" = "Montenegro", "Mozambique" = "Mozambique",
"Myanmar" = "Myanmar", "Namibia" = "Namibia", "Nepal" = "Nepal",
"Nicaragua" = "Nicaragua", "Niger" = "Niger", "Nigeria" = "Nigeria",
"Noruega" = "Norway", "Nueva Zelanda" = "New Zealand", "Oman" = "Oman",
"Paises Bajos" = "Netherlands", "Pakistan" = "Pakistan", "Panama" = "Panama",
"Papua Nueva Guinea" = "Papua New Guinea", "Paraguay" = "Paraguay",
"Peru" = "Peru", "Polonia" = "Poland", "Portugal" = "Portugal",
"Puerto Rico" = "Puerto Rico", "Catar" = "Qatar", "Reino Unido" = "United Kingdom",
"Republica Checa" = "Czech Republic", "Rumania" = "Romania", "Rusia" = "Russia",
"Ruanda" = "Rwanda", "Senegal" = "Senegal", "Serbia" = "Serbia",
"Singapur" = "Singapore", "Siria" = "Syria", "Somalia" = "Somalia",
"Sri Lanka" = "Sri Lanka", "Sudafrica" = "South Africa", "Sudan" = "Sudan",
"Sudan del Sur" = "South Sudan", "Suecia" = "Sweden", "Suiza" = "Switzerland",
"Tailandia" = "Thailand", "Tanzania" = "Tanzania", "Tayikistan" = "Tajikistan",
"Togo" = "Togo", "Trinidad y Tobago" = "Trinidad and Tobago", "Tunez" = "Tunisia",
"Turquia" = "Turkey", "Turkmenistan" = "Turkmenistan", "Ucrania" = "Ukraine",
"Uganda" = "Uganda", "Uruguay" = "Uruguay", "Uzbekistan" = "Uzbekistan",
"Venezuela" = "Venezuela", "Vietnam" = "Vietnam", "Yemen" = "Yemen",
"Zambia" = "Zambia", "Zimbabue" = "Zimbabwe", "Afghanistan" = "Afghanistan",
"Albania" = "Albania", "Angola" = "Angola", "Armenia" = "Armenia",
"Azerbaiyan" = "Azerbaijan", "Bahamas" = "Bahamas", "Bahrein" = "Bahrain",
"Bangladesh" = "Bangladesh", "Barbados" = "Barbados", "Bielorrusia" = "Belarus",
"Belice" = "Belize", "Benin" = "Benin", "Butan" = "Bhutan",
"Bosnia y Herzegovina" = "Bosnia and Herzegovina", "Botsuana" = "Botswana",
"Brunei" = "Brunei", "Bulgaria" = "Bulgaria", "Burkina Faso" = "Burkina Faso",
"Burundi" = "Burundi", "Cabo Verde" = "Cape Verde", "Camboya" = "Cambodia",
"Camerun" = "Cameroon", "Chad" = "Chad", "Chipre" = "Cyprus",
"Comoras" = "Comoros", "Congo" = "Congo", "Republica Democratica del Congo" = "Democratic Republic of the Congo",
"Islas Cook" = "Cook Islands", "Costa de Marfil" = "Ivory Coast", "Yibuti" = "Djibouti",
"Dominica" = "Dominica", "Republica Dominicana" = "Dominican Republic",
"Timor Oriental" = "East Timor", "Guinea Ecuatorial" = "Equatorial Guinea",
"Eritrea" = "Eritrea", "Eswatini" = "Eswatini", "Fiyi" = "Fiji",
"Gabon" = "Gabon", "Gambia" = "Gambia", "Granada" = "Grenada",
"Guinea" = "Guinea", "Guinea-Bisau" = "Guinea-Bissau", "Guyana" = "Guyana",
"Islandia" = "Iceland", "Kiribati" = "Kiribati", "Kosovo" = "Kosovo",
"Kirguistan" = "Kyrgyzstan", "Laos" = "Laos", "Lesoto" = "Lesotho",
"Liberia" = "Liberia", "Liechtenstein" = "Liechtenstein", "Macedonia del Norte" = "North Macedonia",
"Madagascar" = "Madagascar", "Malaui" = "Malawi", "Mauritania" = "Mauritania",
"Micronesia" = "Micronesia", "Nauru" = "Nauru", "Palaos" = "Palau",
"Palestina" = "Palestine", "Samoa" = "Samoa", "San Marino" = "San Marino",
"Santo Tome y Principe" = "Sao Tome and Principe", "Seychelles" = "Seychelles",
"Sierra Leona" = "Sierra Leone", "Islas Salomon" = "Solomon Islands",
"Surinam" = "Suriname", "Tonga" = "Tonga", "Tuvalu" = "Tuvalu",
"Vanuatu" = "Vanuatu"
)
# Traducir nombres de español a inglés
Base_clusters$Pais_ingles <- traduccion_paises[Base_clusters$Pais]
# Para países que no necesitan traducción
Base_clusters$Pais_ingles[is.na(Base_clusters$Pais_ingles)] <- Base_clusters$Pais[is.na(Base_clusters$Pais_ingles)]
# Convertir a códigos ISO3
Base_clusters$Codigo <- countrycode(
Base_clusters$Pais_ingles,
origin = "country.name",
destination = "iso3c",
warn = FALSE
)
# Correcciones manuales para casos especiales
correcciones_manuales <- c(
"Estados Unidos" = "USA", "Reino Unido" = "GBR", "Corea del Sur" = "KOR",
"Corea del Norte" = "PRK", "Republica Democratica del Congo" = "COD",
"Paises Bajos" = "NLD", "Republica Checa" = "CZE", "Espana" = "ESP",
"Turquia" = "TUR", "Japon" = "JPN"
)
for (pais in names(correcciones_manuales)) {
idx <- which(Base_clusters$Pais == pais)
if (length(idx) > 0) {
Base_clusters$Codigo[idx] <- correcciones_manuales[pais]
}
}
# Unir con el mapa mundial
Base_con_mapa <- world %>%
left_join(Base_clusters, by = c("iso_a3" = "Codigo")) %>%
filter(!is.na(Cluster))
# Nombres descriptivos para los clusters
nombres_clusters <- c("1" = "Cluster 1: Alta Calidad de Salud",
"2" = "Cluster 2: Desafíos de Salud Pública")
# Paleta de colores (verde y azul)
pal <- colorFactor(
palette = c(verde_cluster1, azul_cluster2),
domain = 1:2,
na.color = "transparent"
)
# Crear mapa interactivo
mapa_clusters <- leaflet(Base_con_mapa) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(Cluster),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.7,
popup = ~paste(
"<b>País:</b>", Pais, "<br>",
"<b>Clúster:</b>", nombres_clusters[as.character(Cluster)], "<br>",
"<b>Esperanza de Vida:</b> Variable según datos"
),
highlight = highlightOptions(
weight = 3,
color = "#666",
fillOpacity = 0.9,
bringToFront = TRUE
)
) %>%
addLegend(
"bottomright",
pal = pal,
values = ~Cluster,
title = "Clasificación por Salud Pública",
labFormat = function(type, cuts, p) {
paste0(nombres_clusters[cuts])
},
opacity = 0.8
)
mapa_clustersCaracterización de Dimensiones Principales
library(gt)
# Obtener las cargas de las variables (loadings)
loadings <- res.pca$rotation
# Función para obtener las top variables
get_top_vars <- function(pc_index, n = 3, positive = TRUE) {
vars <- loadings[, pc_index]
if (positive) {
top <- sort(vars, decreasing = TRUE)[1:n]
} else {
top <- sort(vars, decreasing = FALSE)[1:n]
}
# Formatear con nombres cortos
formatted <- sapply(names(top), function(v) {
nombre <- nombres_cortos_var[v]
if (is.na(nombre)) nombre <- v
paste0(nombre, " (", round(top[v], 3), ")")
})
paste(formatted, collapse = ", ")
}
# Crear dataframe de caracterización
caracterizacion_componentes <- data.frame(
Componente = c("PC1", "PC2", "PC3"),
Nombre = c(
"Calidad de Salud Pública",
"Edad de Mortalidad",
"Escala Poblacional"
),
Varianza_Explicada = c(
paste0(round(var_exp[1], 1), "%"),
paste0(round(var_exp[2], 1), "%"),
paste0(round(var_exp[3], 1), "%")
),
Variables_Positivas = c(
get_top_vars(1, 4, TRUE),
get_top_vars(2, 3, TRUE),
get_top_vars(3, 2, TRUE)
),
Variables_Negativas = c(
get_top_vars(1, 4, FALSE),
get_top_vars(2, 3, FALSE),
get_top_vars(3, 2, FALSE)
),
Interpretación = c(
"Países desarrollados con alta esperanza de vida y baja mortalidad infantil vs países con sistemas de salud frágiles y alta mortalidad prevenible",
"Mortalidad concentrada en etapas tempranas de la vida (infantil/neonatal) vs mortalidad por enfermedades crónicas en edad adulta",
"Efecto del tamaño poblacional: países grandes con números absolutos altos de muertes vs países pequeños con tasas per cápita"
)
)
# Crear tabla con formato profesional
tabla_caracterizacion <- caracterizacion_componentes %>%
gt() %>%
tab_header(
title = md("**CARACTERIZACIÓN DE DIMENSIONES PRINCIPALES**"),
subtitle = "Análisis de Componentes Principales - Mortalidad Global"
) %>%
cols_label(
Componente = md("**Comp.**"),
Nombre = md("**Dimensión Identificada**"),
Varianza_Explicada = md("**% Varianza**"),
Variables_Positivas = md("**Variables con Cargas Positivas**"),
Variables_Negativas = md("**Variables con Cargas Negativas**"),
Interpretación = md("**Interpretación Conceptual**")
) %>%
cols_align(
align = "left",
columns = everything()
) %>%
cols_width(
Componente ~ px(80),
Nombre ~ px(200),
Varianza_Explicada ~ px(100),
Variables_Positivas ~ px(250),
Variables_Negativas ~ px(250),
Interpretación ~ px(300)
) %>%
tab_style(
style = list(
cell_text(weight = "bold", size = "medium"),
cell_fill(color = verde_cluster1),
cell_text(color = "white")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_borders(
sides = c("top", "bottom"),
color = "black",
weight = px(2)
),
locations = list(
cells_column_labels(),
cells_body()
)
) %>%
tab_style(
style = cell_text(weight = "bold", color = verde_cluster1),
locations = cells_body(columns = c(Componente, Nombre))
) %>%
tab_style(
style = cell_text(size = "small"),
locations = cells_body(columns = c(Variables_Positivas, Variables_Negativas, Interpretación))
) %>%
tab_style(
style = cell_fill(color = "#F8F9FA"),
locations = cells_body(rows = c(1, 3))
) %>%
tab_options(
table.font.names = "Times New Roman",
table.width = pct(100),
table.border.top.style = "none",
table.border.bottom.style = "none",
column_labels.border.top.style = "none",
column_labels.border.bottom.width = px(2),
column_labels.border.bottom.color = "black",
table_body.border.bottom.style = "none",
table_body.border.top.style = "none",
data_row.padding = px(10),
heading.title.font.size = 16,
heading.subtitle.font.size = 13,
heading.padding = px(8)
) %>%
tab_source_note(
source_note = md("**Fuente:** Elaboración propia con base en análisis PCA de indicadores de mortalidad (Banco Mundial, OMS)")
) %>%
tab_footnote(
footnote = "Los valores entre paréntesis indican la carga (loading) de cada variable en el componente respectivo",
locations = cells_column_labels(columns = Variables_Positivas)
)
tabla_caracterizacion| CARACTERIZACIÓN DE DIMENSIONES PRINCIPALES | |||||
| Análisis de Componentes Principales - Mortalidad Global | |||||
| Comp. | Dimensión Identificada | % Varianza | Variables con Cargas Positivas1 | Variables con Cargas Negativas | Interpretación Conceptual |
|---|---|---|---|---|---|
| PC1 | Calidad de Salud Pública | 62.3% | Exp Vida Mujer (0.265), Exp Vida Hombre (0.264), Superv 65 Mujer (0.263), Superv 65 Hombre (0.257) | Mort Adulta Mujer (-0.258), Mort Infantil Hombre (-0.257), Mort Infantil Mujer (-0.256), Mort Temprana Hombre (-0.249) | Países desarrollados con alta esperanza de vida y baja mortalidad infantil vs países con sistemas de salud frágiles y alta mortalidad prevenible |
| PC2 | Edad de Mortalidad | 11.6% | Muertes Infantiles (0.269), Muertes Neonatales (0.263), Mort Neonatal (0.146) | Suicidios Hombre (-0.504), Suicidios Mujer (-0.42), Envenenamiento Hombre (-0.364) | Mortalidad concentrada en etapas tempranas de la vida (infantil/neonatal) vs mortalidad por enfermedades crónicas en edad adulta |
| PC3 | Escala Poblacional | 8.4% | Muertes Neonatales (0.621), Muertes Infantiles (0.61) | Accidentes Tránsito (-0.135), Mort Adulta Hombre (-0.033) | Efecto del tamaño poblacional: países grandes con números absolutos altos de muertes vs países pequeños con tasas per cápita |
| Fuente: Elaboración propia con base en análisis PCA de indicadores de mortalidad (Banco Mundial, OMS) | |||||
| 1 Los valores entre paréntesis indican la carga (loading) de cada variable en el componente respectivo | |||||