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)

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

# Renombrar columnas
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

# Ver las primeras filas y columnas
head(Muertes_df[, 1:6])

# Realizar el ACP con datos ya escalados
res.pca <- prcomp(Muertes_df, scale = FALSE)
res.pca

##matriz correlaciones

library(ggplot2)
library(reshape2)

# Vector de nombres cortos con los nombres correctos del dataframe:
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"
)

# 1. Selecciona las 22 variables (excluye País)
variables_requeridas <- names(nombres_cortos)
Muertes_filtradas <- Muertes[, variables_requeridas]
Muertes_filtradas[] <- lapply(Muertes_filtradas, as.numeric)

# 2. Renombra columnas a los cortos
colnames(Muertes_filtradas) <- nombres_cortos

# 3. Elimina filas con NA
Muertes_filtradas <- na.omit(Muertes_filtradas)

# 4. Calcula la matriz de correlación
cor_matrix <- cor(Muertes_filtradas, use = "pairwise.complete.obs")

# 5. Prepara datos para graficar sin NA
library(reshape2)
cor_melted <- melt(cor_matrix)
names(cor_melted) <- c("Var1", "Var2", "value")

# 6. Gráfica
library(ggplot2)
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",  # Mostrar varianza en lugar de eigenvalues
         geom = "bar",         # Usar barras en lugar de líneas
         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)

Gráfico de Individuos (Países)

library(factoextra)
library(plotly)

# Extraer datos del PCA - asumiendo que res.pca es un objeto de FactoMineR
pca_data <- get_pca_ind(res.pca)

# Crear dataframe con las 2 primeras dimensiones
df <- data.frame(
  País = rownames(pca_data$coord),
  PC1 = pca_data$coord[,1],
  PC2 = pca_data$coord[,2]
)

# Calcular calidad de representación (cos2) en las 2 dimensiones
if(!is.null(pca_data$cos2)) {
  df$Cos2 <- rowSums(pca_data$cos2[,1:2])
} else {
  # Si no hay cos2, calculamos manualmente como la suma de los cuadrados de las coordenadas en las dos primeras dimensiones dividido por la suma de los cuadrados de todas las coordenadas
  df$Cos2 <- (df$PC1^2 + df$PC2^2) / rowSums(pca_data$coord^2)
}

# Obtener los porcentajes de varianza explicada
# Para un objeto de FactoMineR, los autovalores y porcentajes están en res.pca$eig
if(inherits(res.pca, "PCA")) {
  # Si es un objeto PCA de FactoMineR
  percent_pc1 <- round(res.pca$eig[1,2], 1)
  percent_pc2 <- round(res.pca$eig[2,2], 1)
} else {
  # Si es un objeto de prcomp (o otro)
  # Calculamos la varianza explicada
  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)
}

# Crear 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 = "Calidad (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
  )

# Mostrar el gráfico
p3

Gráfico de Variables

library(factoextra)
library(plotly)
library(dplyr)

# Extraer datos de las variables
var_data <- get_pca_var(res.pca)

# Crear dataframe con información completa para PC1 y PC2
df_var <- data.frame(
  Variable = rownames(var_data$coord),
  PC1 = var_data$coord[,1],
  PC2 = var_data$coord[,2],  # Cambiado: PC2 en lugar de PC3
  Contrib = rowSums(var_data$contrib[,c(1,2)]),  # Contribución total a PC1 y PC2
  Cos2 = rowSums(var_data$cos2[,c(1,2)])        # Calidad de representación en PC1 y PC2
)

# Crear gráfico interactivo profesional - SIN ETIQUETAS PERMANENTES
grafico_profesional <- plot_ly(df_var, x = ~PC1, y = ~PC2,  # Cambiado: PC2 en lugar de PC3
        type = 'scatter',
        mode = 'markers',  # Solo markers, sin text
        marker = list(
          size = 12,
          color = ~Contrib,
          colorscale = list(
            c(0, "#00AFBB"),
            c(0.3, "#00AFBB"),
            c(0.5, "#E7B800"),
            c(1, "#FC4E07")
          ),
          showscale = TRUE,
          colorbar = list(
            title = "Contribución",
            thickness = 15,
            len = 0.5
          ),
          opacity = 0.8,
          line = list(
            width = 2,
            color = 'darkgray'
          )
        ),
        hoverinfo = 'text',
        hovertext = ~paste(
          '<b>Variable:</b>', Variable,
          '<br><b>PC1:</b>', round(PC1, 3),
          '<br><b>PC2:</b>', round(PC2, 3),  # Cambiado: PC2 en lugar de PC3
          '<br><b>Contribución:</b>', round(Contrib, 1), '%',
          '<br><b>Calidad (cos2):</b>', round(Cos2, 3)
        ),
        hoverlabel = list(
          bgcolor = "white",
          bordercolor = "black",
          font = list(color = "black", size = 12)
        )
) %>%
  layout(
    title = list(
      text = "<b>Análisis PCA - Contribución de Variables (PC1 vs PC2)</b>",  # Cambiado el título
      font = list(size = 16, family = "Arial"),
      x = 0.05
    ),
    xaxis = list(
      title = list(
        text = "PC1",
        font = list(size = 14, family = "Arial")
      ),
      gridcolor = "lightgray",
      zeroline = TRUE,
      zerolinecolor = "black",
      zerolinewidth = 1,
      showgrid = TRUE
    ),
    yaxis = list(
      title = list(
        text = "PC2",  # Cambiado: PC2 en lugar de PC3
        font = list(size = 14, family = "Arial")
      ),
      gridcolor = "lightgray",
      zeroline = TRUE,
      zerolinecolor = "black",
      zerolinewidth = 1,
      showgrid = TRUE
    ),
    plot_bgcolor = "white",
    paper_bgcolor = "white",
    margin = list(l = 80, r = 80, b = 80, t = 80),
    showlegend = FALSE,
    font = list(family = "Arial")
  )

# Mostrar el gráfico
grafico_profesional

Resultados del ACP

##Valores Propios

eig.val <- get_eigenvalue(res.pca)
eig.val

##Resultados para Variables

res.var <- get_pca_var(res.pca)

# Coordenadas
head(res.var$coord)

# Contribuciones a los CPs
head(res.var$contrib)

# Calidad de representación
head(res.var$cos2)
# Visualizar contribuciones de variables a los primeros componentes
colSums(res.var$contrib[,1:2])

Resultados para Países

res.ind <- get_pca_ind(res.pca)

# Coordenadas
head(res.ind$coord)

# Contribuciones a los CPs
head(res.ind$contrib[,1:3])

# Calidad de representación
head(res.ind$cos2)

Tabla Interactiva de Contribuciones

library(reactable)
library(reactablefmtr)
## 
## Adjuntando el paquete: 'reactablefmtr'
## The following object is masked from 'package:ggplot2':
## 
##     margin
# 1. Paleta de color
verde_principal <- "#488B49"

# 2. Función para crear escala de colores: de blanco a verde
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)
}

# 3. Función auxiliar 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 '#2E7D32'
}

# 4. Crea tu dataframe (ajusta res.ind$contrib según tu análisis)
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), ]

# 5. Genera los colores
pc1_colors <- color_scale(contribuciones_df$PC1)
pc2_colors <- color_scale(contribuciones_df$PC2)
pc3_colors <- color_scale(contribuciones_df$PC3)

# 6. Tabla reactable con estilos correctos y contraste de texto automático
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_contribuciones
# Crear tabla del top 5 de contribución a PC1 por países
top5_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))

# Mostrar tabla formateada
library(kableExtra)
## 
## Adjuntando el paquete: 'kableExtra'
## The following object is masked from 'package:dplyr':
## 
##     group_rows
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:")
Top 5 Países por Contribución al Componente Principal 1 (PC1)
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. 
# Crear tabla del top 5 de menor contribución a PC1 por países
bottom5_pc1 <- res.ind$contrib[,1, drop = FALSE] %>%
  as.data.frame() %>%
  arrange(.[,1]) %>%  # Orden ascendente esta vez
  head(5) %>%
  rename("Contribución (%)" = 1) %>%
  mutate(País = rownames(.)) %>%
  select(País, "Contribución (%)") %>%
  mutate("Contribución (%)" = round(`Contribución (%)`, 3))

# Mostrar tabla formateada
bottom5_pc1 %>%
  kbl(align = c('l', 'c'),
      caption = "Top 5 Países con Menor 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. Valores bajos indican menor influencia en la dirección del componente.",
           general_title = "Nota:")
Top 5 Países con Menor Contribución al Componente Principal 1 (PC1)
País Contribución (%)
Kirguistan Kirguistan 0.000
Uzbekistan Uzbekistan 0.000
Irak Irak 0.000
Guatemala Guatemala 0.001
Indonesia Indonesia 0.001
Nota:
La contribución representa el porcentaje de varianza explicado por cada país en el primer componente principal. Valores bajos indican menor influencia en la dirección del componente. 
# Crear tabla del top 5 de contribución a PC2 por países
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))

# Mostrar tabla formateada
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:")
Top 5 Países por Contribución al Componente Principal 2 (PC2)
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. 
# Crear tabla del top 5 de menor contribución a PC2 por países
bottom5_pc2 <- res.ind$contrib[,2, drop = FALSE] %>%
  as.data.frame() %>%
  arrange(.[,1]) %>%  # Orden ascendente para los menores valores
  head(5) %>%
  rename("Contribución (%)" = 1) %>%
  mutate(País = rownames(.)) %>%
  select(País, "Contribución (%)") %>%
  mutate("Contribución (%)" = round(`Contribución (%)`, 3))

# Mostrar tabla formateada
bottom5_pc2 %>%
  kbl(align = c('l', 'c'),
      caption = "Top 5 Países con Menor 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. Valores bajos indican menor influencia en esta dimensión ortogonal al PC1.",
           general_title = "Nota:")
Top 5 Países con Menor Contribución al Componente Principal 2 (PC2)
País Contribución (%)
Botswana Botswana 0.000
Nueva Zelanda Nueva Zelanda 0.000
Comoros Comoros 0.001
Denmark Denmark 0.001
El Salvador El Salvador 0.001
Nota:
La contribución representa el porcentaje de varianza explicado por cada país en el segundo componente principal. Valores bajos indican menor influencia en esta dimensión ortogonal al PC1. 
# Crear tabla del top 5 de contribución a PC3 por países
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))

# Mostrar tabla formateada
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:")
Top 5 Países por Contribución al Componente Principal 3 (PC3)
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. 
# Crear tabla del top 5 de menor contribución a PC3 por países
bottom5_pc3 <- res.ind$contrib[,3, drop = FALSE] %>%
  as.data.frame() %>%
  arrange(.[,1]) %>%  # Orden ascendente para los menores valores
  head(5) %>%
  rename("Contribución (%)" = 1) %>%
  mutate(País = rownames(.)) %>%
  select(País, "Contribución (%)") %>%
  mutate("Contribución (%)" = round(`Contribución (%)`, 3))

# Mostrar tabla formateada
bottom5_pc3 %>%
  kbl(align = c('l', 'c'),
      caption = "Top 5 Países con Menor 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. Valores bajos indican menor influencia en esta tercera dimensión de variabilidad.",
           general_title = "Nota:")
Top 5 Países con Menor Contribución al Componente Principal 3 (PC3)
País Contribución (%)
Irlanda Irlanda 0.000
Sudan Sudan 0.000
Angola Angola 0.000
Espana Espana 0.000
Cabo Verde Cabo Verde 0.001
Nota:
La contribución representa el porcentaje de varianza explicado por cada país en el tercer componente principal. Valores bajos indican menor influencia en esta tercera dimensión de variabilidad.

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)  # Para extraer datos del dendrograma

# Función mejorada que incluye el dendrograma visualizado
crear_dendrograma_interactivo_mejorado <- function(hc) {
  
  # Obtener la altura máxima del dendrograma
  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)
  
  # 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 = FALSE,
        range = c(0, max(segmentos$xend) + 1)
      ),
      yaxis = list(
        title = "Distancia", 
        range = c(0, altura_max * 1.1)
      ),
      showlegend = FALSE
    )
  
  # Agregar línea de corte inicial
  fig <- fig %>% add_lines(
    x = c(0, max(segmentos$xend) + 1),
    y = c(alturas[1], alturas[1]),
    line = list(color = "red", width = 3, dash = "dash"),
    name = "Línea de corte"
  )
  
  # Preparar steps para el slider
  steps <- list()
  
  for (i in 1:length(alturas)) {
    altura_actual <- alturas[i]
    
    step <- list(
      method = "restyle",
      args = list(
        "y",  # Propiedad a modificar
        list(c(altura_actual, altura_actual)),  # Nuevo valor
        list(1)  # Índice de la traza (la línea de corte)
      ),
      label = sprintf("%.1f", altura_actual)
    )
    steps[[i]] <- step
  }
  
  # Configurar slider
  fig <- fig %>% layout(
    sliders = list(
      list(
        active = 0,
        currentvalue = list(prefix = "Altura de corte: "),
        pad = list(t = 50),
        steps = steps
      )
    )
  )
  
  return(fig)
}

# EJECUTAR el código
if(exists("hc")) {
  dend_interactivo <- crear_dendrograma_interactivo_mejorado(hc)
  dend_interactivo
} else {
  # Si hc no 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")
  
  dend_interactivo <- crear_dendrograma_interactivo_mejorado(hc)
  dend_interactivo
}
library(plotly)
library(factoextra)
library(viridis)

# Crear matriz de distancia y dendrograma
dist_matrix <- dist(resultado_ACP$dudi$li[, 1:3])
hc <- hclust(dist_matrix, method = "ward.D2")

# Obtener los nombres de los países
paises <- rownames(resultado_ACP$dudi$li)

# Primero crear el dendrograma con factoextra para obtener la estructura
dendro_plot <- fviz_dend(hc, k = 2, 
                         cex = 0.6,
                         k_colors = viridis(2),
                         color_labels_by_k = TRUE,
                         ggtheme = theme_minimal(),
                         main = "Dendrograma - Clasificación Jerárquica",
                         xlab = "Países", ylab = "Distancia")

# Convertir el ggplot a plotly manteniendo los colores y estructura
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  # Ocultar etiquetas del eje X para evitar desorden
    ),
    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)
    )
  )

# Función para obtener el nombre del país basado en la posición
get_country_name <- function(position) {
  if (position >= 1 && position <= length(paises)) {
    return(paises[position])
  }
  return("N/A")
}

# Mejorar los tooltips para mostrar nombres de países
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)  # Aplicar a los traces de segmentos y puntos
  )

# Mostrar el gráfico interactivo
plotly_dendro

Gráfico de Individuos (Países) - Componentes 1 y 2

plotly_p1 <- plot_ly(acp_ind, 
                     x = ~Axis1, y = ~Axis2, 
                     color = ~Cluster,
                     colors = viridis_pal()(2),
                     text = ~paste("País:", Pais, 
                                   "Cluster:", Cluster,
                                   "Comp1:", round(Axis1, 2),
                                   "Comp2:", round(Axis2, 2)),
                     hoverinfo = "text",
                     type = "scatter",
                     mode = "markers",
                     marker = list(size = 10, opacity = 0.7, line = list(width = 1))) %>%
  layout(title = "ACP Interactivo - Países por Cluster",
         xaxis = list(title = paste0("Dimensión 1 (", var_exp[1], "%)")),
         yaxis = list(title = paste0("Dimensión 2 (", var_exp[2], "%)")),
         hoverlabel = list(bgcolor = "white"))

plotly_p1

Círculo de Correlaciones

library(plotly)

# Crear nombres cortos para las variables
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",
  "Supervivenencia_hasta_los_65_anos_mujeres" = "Superv 65 Mujer",
  "Supervivenencia_hasta_los_65_anos_hombres" = "Superv 65 Hombre"
)

# Preparar datos
circle_data <- data.frame(
  Axis1 = acp_var[,1],
  Axis2 = acp_var[,2],
  Variable = rownames(acp_var)
)

# Aplicar nombres cortos
circle_data$NombreCorto <- nombres_cortos[circle_data$Variable]

# Calcular métricas para tooltips
circle_data$Longitud <- sqrt(circle_data$Axis1^2 + circle_data$Axis2^2)
circle_data$Angulo <- round(atan2(circle_data$Axis2, circle_data$Axis1) * 180/pi, 1)
circle_data$Correlacion <- round(circle_data$Longitud, 3)

# Crear gráfico interactivo profesional
plot_interactivo <- plot_ly() %>%
  
  # Añadir círculo de referencia
  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 = "blue", dash = "dash", width = 1),
    hoverinfo = "none",
    showlegend = FALSE,
    name = "Círculo unidad"
  ) %>%
  
  # Añadir flechas
  add_annotations(
    x = circle_data$Axis1,
    y = circle_data$Axis2,
    ax = 0,
    ay = 0,
    text = "",
    showarrow = TRUE,
    arrowhead = 2,
    arrowsize = 1.2,
    arrowwidth = 2,
    arrowcolor = "#E41A1C",
    opacity = 0.8
  ) %>%
  
  # Añadir puntos interactivos
  add_trace(
    data = circle_data,
    x = ~Axis1,
    y = ~Axis2,
    type = "scatter",
    mode = "markers",
    marker = list(
      size = 10,
      color = "#E41A1C",
      line = list(color = "white", width = 2)
    ),
    text = ~paste(
      "<b>Variable:</b> ", NombreCorto,
      "<br><b>Correlación Comp. 1:</b> ", round(Axis1, 3),
      "<br><b>Correlación Comp. 2:</b> ", round(Axis2, 3),
      "<br><b>Longitud vector:</b> ", round(Longitud, 3),
      "<br><b>Ángulo:</b> ", Angulo, "°",
      "<br><b>Variable original:</b><br>", Variable
    ),
    hoverinfo = "text",
    hoverlabel = list(bgcolor = "white", bordercolor = "black"),
    showlegend = FALSE
  ) %>%
  
  # Añadir etiquetas con nombres cortos
  add_annotations(
    x = circle_data$Axis1 * 1.15,
    y = circle_data$Axis2 * 1.15,
    text = circle_data$NombreCorto,
    showarrow = FALSE,
    font = list(
      family = "Arial",
      size = 11,
      color = "darkred",
      weight = "bold"
    ),
    bgcolor = "rgba(255,255,255,0.85)",
    bordercolor = "rgba(200,0,0,0.3)",
    borderwidth = 1,
    borderpad = 4,
    opacity = 0.9
  ) %>%
  
  layout(
    title = list(
      text = paste0(
        "<b> CÍRCULO DE CORRELACIONES - </b><br>",
        "<sup>Dimensión 1 (", var_exp[1], "%) vs Dimensión 2 (", var_exp[2], "%)</sup>"
      ),
      x = 0.5,
      font = list(size = 20, family = "Arial")
    ),
    xaxis = list(
      title = paste0("<b>Dimensión 1 (", var_exp[1], "%)</b>"),
      range = c(-1.3, 1.3),
      gridcolor = "lightgray",
      zeroline = TRUE,
      zerolinecolor = "black",
      zerolinewidth = 1.5,
      titlefont = list(size = 14)
    ),
    yaxis = list(
      title = paste0("<b>Dimensión 2 (", var_exp[2], "%)</b>"),
      range = c(-1.3, 1.3),
      gridcolor = "lightgray",
      zeroline = TRUE,
      zerolinecolor = "black",
      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)
    ),
    showlegend = FALSE,
    margin = list(t = 100, b = 80, l = 80, r = 80)
  )

plot_interactivo

Biplot Interactivo

# Crear nombres cortos para las variables
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",
  "Supervivenencia_hasta_los_65_anos_mujeres" = "Superv 65 Mujer",
  "Supervivenencia_hasta_los_65_anos_hombres" = "Superv 65 Hombre"
)

# Aplicar nombres cortos a circle_data
circle_data$Variable_corto <- nombres_cortos[circle_data$Variable]

# Crear lista de anotaciones para las 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)

# Biplot interactivo profesional CORREGIDO
plotly_biplot <- plot_ly()

# Agregar un trace por cada cluster
for(cluster in clusters) {
  datos_cluster <- acp_ind[acp_ind$Cluster == 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')),
              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 variables - TEXTO
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")

# Crear la configuración de visibilidad según número de clusters
n_clusters <- length(clusters)
# Para "Solo Países": primeros n_clusters traces visibles, último oculto
visible_solo_paises <- c(rep(TRUE, n_clusters), FALSE)
# Para "Solo Variables": primeros n_clusters traces ocultos, último visible
visible_solo_variables <- c(rep(FALSE, n_clusters), TRUE)
# Para "Ambos": todos visibles
visible_ambos <- rep(TRUE, n_clusters + 1)

# Layout con botones corregidos
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
    ),
    # Agregar las flechas como anotaciones fijas
    annotations = anotaciones_flechas,
    # Botones de control CORREGIDOS
    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(
          # Botón 1: Solo Países
          list(
            method = "update",
            args = list(
              list(visible = as.list(visible_solo_paises)),
              list(annotations = list())
            ),
            label = "Solo Países"
          ),
          # Botón 2: Solo Variables
          list(
            method = "update",
            args = list(
              list(visible = as.list(visible_solo_variables)),
              list(annotations = anotaciones_flechas)
            ),
            label = "Solo Variables"
          ),
          # Botón 3: Ambos
          list(
            method = "update",
            args = list(
              list(visible = as.list(visible_ambos)),
              list(annotations = anotaciones_flechas)
            ),
            label = "Ambos"
          )
        )
      )
    )
  )

plotly_biplot

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 - Componentes Principales 1 y 2",
    subtitle = "Elipses de confianza al 95% con centroides",
    x = paste0("Componente Principal 1 (", var_exp[1], "%)"),
    y = paste0("Componente 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 - Componentes Principales 1 y 3",
    subtitle = "Elipses de confianza al 95% con centroides",
    x = paste0("Componente Principal 1 (", var_exp[1], "%)"),
    y = paste0("Componente 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)

Análisis de Contribución

contrib_data <- acp_var %>%
  mutate(Contrib1 = abs(Axis1) / sum(abs(Axis1)) * 100,
         Contrib2 = abs(Axis2) / sum(abs(Axis2)) * 100) %>%
  pivot_longer(cols = c(Contrib1, Contrib2), 
               names_to = "Componente", 
               values_to = "Contribucion")

p6 <- ggplot(contrib_data, aes(x = reorder(Variable, Contribucion), 
                               y = Contribucion, fill = Componente)) +
  geom_bar(stat = "identity", position = "dodge") +
  scale_fill_viridis(discrete = TRUE, begin = 0.3, end = 0.8) +
  labs(
    title = "Contribución de Variables a los Componentes Principales",
    x = "Variables",
    y = "Contribución Absoluta (%)",
    fill = "Componente"
  ) +
  coord_flip() +
  theme_minimal()

print(p6)

Información General del Análisis

Resumen Estadístico del Análisis

1. Información General