VPH

DESCRIPTIVO POR AÑO

summary(Datos)

##     Lugar                2005             2006             2007       
##  Length:8           Min.   : 8.730   Min.   : 8.590   Min.   : 7.810  
##  Class :character   1st Qu.: 9.705   1st Qu.: 8.675   1st Qu.: 8.055  
##  Mode  :character   Median :10.330   Median : 9.155   Median : 9.150  
##                     Mean   :10.471   Mean   : 9.630   Mean   :10.366  
##                     3rd Qu.:11.357   3rd Qu.: 9.682   3rd Qu.:11.568  
##                     Max.   :12.110   Max.   :12.910   Max.   :17.410  
##       2008             2009             2010             2011       
##  Min.   : 7.880   Min.   : 8.500   Min.   : 7.960   Min.   : 6.890  
##  1st Qu.: 9.270   1st Qu.: 9.262   1st Qu.: 8.582   1st Qu.: 8.190  
##  Median : 9.635   Median : 9.565   Median : 9.135   Median : 8.645  
##  Mean   :10.196   Mean   : 9.800   Mean   : 9.331   Mean   : 9.179  
##  3rd Qu.:10.535   3rd Qu.:10.310   3rd Qu.: 9.715   3rd Qu.: 9.223  
##  Max.   :14.560   Max.   :11.740   Max.   :11.170   Max.   :14.220  
##       2012             2013             2014             2015       
##  Min.   : 7.020   Min.   : 5.430   Min.   : 7.620   Min.   : 7.660  
##  1st Qu.: 8.005   1st Qu.: 7.918   1st Qu.: 8.463   1st Qu.: 8.740  
##  Median : 8.255   Median : 8.470   Median : 9.700   Median : 9.065  
##  Mean   : 8.399   Mean   : 8.795   Mean   : 9.456   Mean   : 9.974  
##  3rd Qu.: 8.720   3rd Qu.: 9.248   3rd Qu.:10.242   3rd Qu.:10.143  
##  Max.   :10.160   Max.   :13.090   Max.   :11.310   Max.   :15.350  
##       2016             2017             2018             2019       
##  Min.   : 8.160   Min.   : 8.550   Min.   : 7.940   Min.   : 7.470  
##  1st Qu.: 9.057   1st Qu.: 9.217   1st Qu.: 9.768   1st Qu.: 9.315  
##  Median : 9.740   Median : 9.540   Median :10.160   Median :10.905  
##  Mean   : 9.806   Mean   :10.223   Mean   :10.838   Mean   :10.941  
##  3rd Qu.:10.693   3rd Qu.:10.895   3rd Qu.:12.008   3rd Qu.:12.605  
##  Max.   :11.410   Max.   :13.440   Max.   :13.880   Max.   :15.090  
##       2020             2021            2022            2023p      
##  Min.   : 7.560   Min.   : 7.34   Min.   : 5.860   Min.   : 8.07  
##  1st Qu.: 9.902   1st Qu.:10.17   1st Qu.: 9.795   1st Qu.:10.06  
##  Median :10.585   Median :10.71   Median :10.260   Median :10.99  
##  Mean   :11.115   Mean   :10.98   Mean   :10.250   Mean   :10.72  
##  3rd Qu.:11.758   3rd Qu.:12.29   3rd Qu.:11.315   3rd Qu.:11.46  
##  Max.   :16.570   Max.   :13.96   Max.   :12.720   Max.   :12.96  
##      2024p      
##  Min.   :5.020  
##  1st Qu.:5.985  
##  Median :6.290  
##  Mean   :6.508  
##  3rd Qu.:7.348  
##  Max.   :8.030

# Transformar a formato largo
library(dplyr)

## Warning: package 'dplyr' was built under R version 4.3.3

library(tidyverse)

## Warning: package 'ggplot2' was built under R version 4.3.3

## Warning: package 'tidyr' was built under R version 4.3.3

datos <- Datos
datos_largos <- datos %>%
  pivot_longer(
    cols = -Lugar,
    names_to = "Año",
    values_to = "Tasa"
  ) %>%
  mutate(
    Año = gsub("p", "", Año),   # Eliminar sufijo "p"
    Año = as.integer(Año)
  )

TASA NACIONAL

library(dplyr)
library(tidyverse)
library(ggrepel) 

# Filtrar solo Tasa Nacional
tasa_nacional <- datos_largos %>%
  filter(Lugar == "Tasa_Nacional")

# Graficar con colores azul y turquesa + etiquetas
ggplot(tasa_nacional, aes(x = Año, y = Tasa)) +
  geom_line(color = "blue", size = 1.2) +
  geom_point(color = "turquoise4", size = 2) +
  geom_text_repel(aes(label = round(Tasa, 2)), size = 3, color = "black") +
  labs(
    title = "Tendencia de la Tasa Nacional de Mortalidad por CCU",
    x = "Año",
    y = "Tasa de Mortalidad (por 100,000 habitantes)"
  ) +
  theme_minimal()

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

summary(tasa_nacional)

##     Lugar                Año            Tasa       
##  Length:20          Min.   :2005   Min.   : 6.190  
##  Class :character   1st Qu.:2010   1st Qu.: 9.335  
##  Mode  :character   Median :2014   Median : 9.525  
##                     Mean   :2014   Mean   : 9.392  
##                     3rd Qu.:2019   3rd Qu.: 9.930  
##                     Max.   :2024   Max.   :10.390

ANALISIS POR REGIONES

library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

# Separar nacional y ciudades
nacional <- datos_largos %>% filter(Lugar == "Tasa_Nacional")
ciudades <- datos_largos %>% filter(Lugar != "Tasa_Nacional")

# Crear gráfico interactivo
plot_ly() %>%
  # Línea nacional (resaltada)
  add_trace(
    data = nacional,
    x = ~Año,
    y = ~Tasa,
    type = 'scatter',
    mode = 'lines+markers',
    name = 'Tasa Nacional',
    line = list(color = 'blue', width = 3),
    marker = list(size = 5)
  ) %>%
  # Líneas por ciudad (opcionales al pasar el mouse)
  add_trace(
    data = ciudades,
    x = ~Año,
    y = ~Tasa,
    type = 'scatter',
    mode = 'lines+markers',
    color = ~Lugar,
    text = ~paste("Ciudad:", Lugar, "<br>Tasa:", round(Tasa,2)),
    hoverinfo = "text",
    line = list(width = 1),
    marker = list(size = 4)
  ) %>%
  layout(
    title = "Comparación Interactiva: Tasas mortalidad CCU",
    xaxis = list(title = "Año"),
    yaxis = list(title = "Tasa de Mortalidad (por 100,000)"),
    legend = list(title = list(text = "<b>Selecciona ciudad</b>"))
  )

ANTIOQUIA

antioquia <- datos_largos %>% filter(Lugar == "Tasa_Antioquia")
summary(antioquia)

##     Lugar                Año            Tasa      
##  Length:20          Min.   :2005   Min.   :5.370  
##  Class :character   1st Qu.:2010   1st Qu.:7.635  
##  Mode  :character   Median :2014   Median :8.070  
##                     Mean   :2014   Mean   :8.061  
##                     3rd Qu.:2019   3rd Qu.:8.523  
##                     Max.   :2024   Max.   :9.630

ARAUCA

arauca <- datos_largos %>% filter(Lugar == "Tasa_Arauca")
summary(arauca)

##     Lugar                Año            Tasa      
##  Length:20          Min.   :2005   Min.   : 5.02  
##  Class :character   1st Qu.:2010   1st Qu.:10.52  
##  Mode  :character   Median :2014   Median :11.43  
##                     Mean   :2014   Mean   :11.82  
##                     3rd Qu.:2019   3rd Qu.:14.30  
##                     Max.   :2024   Max.   :17.41

ATLANTICO

atlantico <- datos_largos %>% filter(Lugar == "Tasa_Atlantico")
summary(atlantico)

##     Lugar                Año            Tasa      
##  Length:20          Min.   :2005   Min.   : 6.89  
##  Class :character   1st Qu.:2010   1st Qu.: 8.75  
##  Mode  :character   Median :2014   Median : 9.93  
##                     Mean   :2014   Mean   :10.41  
##                     3rd Qu.:2019   3rd Qu.:12.59  
##                     Max.   :2024   Max.   :13.96

BOGOTA

bogota <- datos_largos %>% filter(Lugar == "Tasa_Bogotá")
summary(bogota)

##     Lugar                Año            Tasa       
##  Length:20          Min.   :2005   Min.   : 6.240  
##  Class :character   1st Qu.:2010   1st Qu.: 8.550  
##  Mode  :character   Median :2014   Median : 9.025  
##                     Mean   :2014   Mean   : 9.162  
##                     3rd Qu.:2019   3rd Qu.: 9.992  
##                     Max.   :2024   Max.   :11.430

NORTE DE SANTANDER

Norte_Santander <- datos_largos %>% filter(Lugar == "Tasa_Norte_Santander")
summary(Norte_Santander)

##     Lugar                Año            Tasa       
##  Length:20          Min.   :2005   Min.   : 7.260  
##  Class :character   1st Qu.:2010   1st Qu.: 8.553  
##  Mode  :character   Median :2014   Median : 9.470  
##                     Mean   :2014   Mean   : 9.937  
##                     3rd Qu.:2019   3rd Qu.:11.590  
##                     Max.   :2024   Max.   :13.110

SANTANDER

Santander <- datos_largos %>% filter(Lugar == "Tasa_Santander")
summary(Santander)

##     Lugar                Año            Tasa       
##  Length:20          Min.   :2005   Min.   : 5.430  
##  Class :character   1st Qu.:2010   1st Qu.: 8.425  
##  Mode  :character   Median :2014   Median : 9.325  
##                     Mean   :2014   Mean   : 8.970  
##                     3rd Qu.:2019   3rd Qu.: 9.795  
##                     Max.   :2024   Max.   :10.990

VALLE

valle <- datos_largos %>% filter(Lugar == "Tasa_Valle")
summary(valle)

##     Lugar                Año            Tasa      
##  Length:20          Min.   :2005   Min.   : 8.03  
##  Class :character   1st Qu.:2010   1st Qu.:10.46  
##  Mode  :character   Median :2014   Median :11.36  
##                     Mean   :2014   Mean   :11.04  
##                     3rd Qu.:2019   3rd Qu.:11.68  
##                     Max.   :2024   Max.   :12.72

MODELO ARIMA PARA TASA NACIONAL MORTALIDAD CCU Y POR REGIONES POR ARIMA Y ETS (Exponential Smoothing)

library(tidyverse)
library(forecast)

## Warning: package 'forecast' was built under R version 4.3.3

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

library(Metrics)

## Warning: package 'Metrics' was built under R version 4.3.3

## 
## Attaching package: 'Metrics'

## The following object is masked from 'package:forecast':
## 
##     accuracy

library(ggplot2)
library(ggrepel)
library(purrr)
library(dplyr)

# --- 1. Leer y preparar datos ---
datos <- Datos

# Transformar a formato largo eliminando año 2024 de la medición
df_largo <- datos %>%
  pivot_longer(cols = -Lugar, names_to = "Año", values_to = "Tasa") %>%
  mutate(
    Año = gsub("p", "", Año),
    Año = as.integer(Año),
    Tasa = as.numeric(Tasa)
  ) %>%
  filter(Año != 2024)

# Definir función de modelado por lugar 
modelar_y_predecir <- function(df_lugar, lugar) {
  serie <- df_lugar %>% filter(Lugar == lugar) %>% arrange(Año)

  # Separar set de entrenamiento (2005–2017) y set de validación (2018–2020)
  train <- serie %>% filter(Año <= 2017)
  test <- serie %>% filter(Año >= 2018 & Año <= 2020)

  ts_train <- ts(train$Tasa, start = min(train$Año), frequency = 1)

  # Entrenar modelos
  modelo_arima <- auto.arima(ts_train)
  modelo_ets <- ets(ts_train)

  # Predicción para años de validación y futuros (2018–2025) con intervalos de confianza al 95%
  forecast_arima <- forecast(modelo_arima, h = 8, level = 95)  
  forecast_ets <- forecast(modelo_ets, h = 8, level = 95)  

  # Evaluación de modelos para años 2018–2020
  real_vals <- test$Tasa
  pred_arima <- forecast_arima$mean[1:3]
  pred_ets <- forecast_ets$mean[1:3]

  evaluacion <- tibble(
    Lugar = lugar,
    Modelo = c("ARIMA", "ETS"),
    MAE = c(mae(real_vals, pred_arima), mae(real_vals, pred_ets)),
    RMSE = c(rmse(real_vals, pred_arima), rmse(real_vals, pred_ets)),
    MAPE = c(mape(real_vals, pred_arima)*100, mape(real_vals, pred_ets)*100)
  )


# Predicciones solo para 2021–2025 = posiciones 4:8
años_pred <- 2021:2025

pred_arima_df <- tibble(
  Año = años_pred,
  Predicción = as.numeric(forecast_arima$mean[4:8]),
  Lower = as.numeric(forecast_arima$lower[4:8, "95%"]),
  Upper = as.numeric(forecast_arima$upper[4:8, "95%"]),
  Modelo = "ARIMA",
  Lugar = lugar
)

pred_ets_df <- tibble(
  Año = años_pred,
  Predicción = as.numeric(forecast_ets$mean[4:8]),
  Lower = as.numeric(forecast_ets$lower[4:8, "95%"]),
  Upper = as.numeric(forecast_ets$upper[4:8, "95%"]),
  Modelo = "ETS",
  Lugar = lugar
)

  # Combinar ambos
  pred_df <- bind_rows(pred_arima_df, pred_ets_df)

  # Gráfico con intervalos de confianza al 95%
  grafico <- ggplot() +
    geom_line(data = serie, aes(x = Año, y = Tasa), color = "gray30") +
    geom_point(data = serie, aes(x = Año, y = Tasa), color = "gray30", size = 1.5) +
    geom_ribbon(data = pred_df, aes(x = Año, ymin = Lower, ymax = Upper, fill = Modelo), alpha = 0.2) +
    geom_line(data = pred_df, aes(x = Año, y = Predicción, color = Modelo), size = 1.2) +
    geom_point(data = pred_df, aes(x = Año, y = Predicción, color = Modelo), size = 2) +
    labs(
      title = paste("Predicción con IC95% -", lugar),
      x = "Año",
      y = "Tasa por 100.000",
      color = "Modelo",
      fill = "Modelo"
    ) +
    theme_minimal()

  return(list(evaluacion = evaluacion, predicciones = pred_df, grafico = grafico))
}

# Aplicar función a cada ciudad
lugares <- unique(df_largo$Lugar)

resultados <- map(lugares, ~modelar_y_predecir(df_largo, .x))

# Unir evaluaciones y predicciones
evaluaciones <- bind_rows(map(resultados, "evaluacion"))
predicciones <- bind_rows(map(resultados, "predicciones"))

# Mostrar tabla de evaluación completa de estadisticos: MAE, RMSE, MAPE por modelo y lugar
print(evaluaciones)

## # A tibble: 16 × 5
##    Lugar                Modelo   MAE  RMSE  MAPE
##    <chr>                <chr>  <dbl> <dbl> <dbl>
##  1 Tasa_Nacional        ARIMA  0.349 0.380  3.51
##  2 Tasa_Nacional        ETS    0.148 0.176  1.49
##  3 Tasa_Antioquia       ARIMA  0.467 0.510  6.18
##  4 Tasa_Antioquia       ETS    0.765 0.791 10.1 
##  5 Tasa_Bogotá          ARIMA  1.24  1.24  12.3 
##  6 Tasa_Bogotá          ETS    1.24  1.24  12.3 
##  7 Tasa_Valle           ARIMA  0.656 0.665  5.86
##  8 Tasa_Valle           ETS    0.656 0.665  5.86
##  9 Tasa_Atlantico       ARIMA  3.57  3.60  27.1 
## 10 Tasa_Atlantico       ETS    0.840 0.961  6.28
## 11 Tasa_Santander       ARIMA  1.49  1.59  15.7 
## 12 Tasa_Santander       ETS    1.49  1.59  15.7 
## 13 Tasa_Norte_Santander ARIMA  2.18  2.41  18.7 
## 14 Tasa_Norte_Santander ETS    2.24  2.51  19.2 
## 15 Tasa_Arauca          ARIMA  2.74  2.95  17.6 
## 16 Tasa_Arauca          ETS    2.73  2.94  17.6

# Calcular promedios por modelo en todos los lugares
resumen_general <- evaluaciones %>%
  group_by(Modelo) %>%
  summarise(
    Promedio_MAE = mean(MAE, na.rm = TRUE),
    Promedio_RMSE = mean(RMSE, na.rm = TRUE),
    Promedio_MAPE = mean(MAPE, na.rm = TRUE)
  )

print(resumen_general)

## # A tibble: 2 × 4
##   Modelo Promedio_MAE Promedio_RMSE Promedio_MAPE
##   <chr>         <dbl>         <dbl>         <dbl>
## 1 ARIMA          1.59          1.67          13.4
## 2 ETS            1.26          1.36          11.1

# Visualizar gráficos
print(resultados[[1]]$grafico)

# Para graficar todos: usar bucle
walk(resultados, ~print(.x$grafico))

# Exportar resultados 
# write.csv(evaluaciones, "Errores_Modelos_Validacion.csv", row.names = FALSE)
# write.csv(predicciones, "Predicciones_Modelos.csv", row.names = FALSE)

Tasa nacional

El modelo ARIMA las predicciones se desvían en promedio 0.35 unidades (MAE) de la tasa de mortalidad del valor real. Mientras que en el modelo ETS, el MAE (error medio absoluto) es mucho menor (0.15 unidades), lo que indica un ajuste más preciso respecto al valor de tasa real. Es decir, que el modelo ETS tiene mejor precisión promedio que ARIMA.

El modelo ARIMA tiene una Raíz del Error Cuadrático Medio (RMSE) de 0.38 que indica mayor dispersión de los errores. Mientras que el modelo ETS tiene un RMSE de 0.176 confirma que las predicciones están más cercanas a los valores reales y con menos errores extremos.Es decir que, ETS nuevamente muestra menor variabilidad en los errores.

En cuanto al error Porcentual Absoluto Medio que mide el porcentaje de error relativo en promedio. Para el modelo ARIMA, Las predicciones tienen un error porcentual medio de 3.5%. Mientras que para el modelo ETS, Las predicciones solo se desvían un 1.5% en promedio respecto a los valores reales. Esto sugiere que ETS es más confiable en términos relativos que el modelo ARIMA.

# tabla ordenada por MAPE descendente para identificar mejores modelos
evaluaciones %>%
  arrange(desc(MAPE)) %>%
  print(n = Inf)

## # A tibble: 16 × 5
##    Lugar                Modelo   MAE  RMSE  MAPE
##    <chr>                <chr>  <dbl> <dbl> <dbl>
##  1 Tasa_Atlantico       ARIMA  3.57  3.60  27.1 
##  2 Tasa_Norte_Santander ETS    2.24  2.51  19.2 
##  3 Tasa_Norte_Santander ARIMA  2.18  2.41  18.7 
##  4 Tasa_Arauca          ARIMA  2.74  2.95  17.6 
##  5 Tasa_Arauca          ETS    2.73  2.94  17.6 
##  6 Tasa_Santander       ARIMA  1.49  1.59  15.7 
##  7 Tasa_Santander       ETS    1.49  1.59  15.7 
##  8 Tasa_Bogotá          ARIMA  1.24  1.24  12.3 
##  9 Tasa_Bogotá          ETS    1.24  1.24  12.3 
## 10 Tasa_Antioquia       ETS    0.765 0.791 10.1 
## 11 Tasa_Atlantico       ETS    0.840 0.961  6.28
## 12 Tasa_Antioquia       ARIMA  0.467 0.510  6.18
## 13 Tasa_Valle           ETS    0.656 0.665  5.86
## 14 Tasa_Valle           ARIMA  0.656 0.665  5.86
## 15 Tasa_Nacional        ARIMA  0.349 0.380  3.51
## 16 Tasa_Nacional        ETS    0.148 0.176  1.49