VPH

DESCRIPTIVO POR AÑO ASI VAMOS EN SALUD

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) ASI VAMOS EN SALUD

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

DESCRIPTIVO POR AÑO DANE

library(readxl)
Datos2 <- read_excel("E:/One_Drive_PUJ/OneDrive - PUJ Cali/PERSONAL/ARTICULOS_CIENTÍFICOS/VPH/Datos/Datos2.xlsx")
View(Datos2)

summary(Datos2)

##     Lugar                1998             1999             2000       
##  Length:34          Min.   : 0.000   Min.   : 0.000   Min.   : 0.000  
##  Class :character   1st Qu.: 4.859   1st Qu.: 5.648   1st Qu.: 6.582  
##  Mode  :character   Median : 6.923   Median : 8.005   Median : 7.736  
##                     Mean   : 7.207   Mean   : 7.854   Mean   : 8.514  
##                     3rd Qu.:10.552   3rd Qu.: 9.684   3rd Qu.:10.855  
##                     Max.   :13.907   Max.   :14.104   Max.   :16.141  
##       2001             2002             2003             2004       
##  Min.   : 0.000   Min.   : 0.000   Min.   : 0.000   Min.   : 0.000  
##  1st Qu.: 6.402   1st Qu.: 4.394   1st Qu.: 5.648   1st Qu.: 5.966  
##  Median : 7.692   Median : 7.844   Median : 7.648   Median : 7.443  
##  Mean   : 8.039   Mean   : 7.246   Mean   : 8.220   Mean   : 7.749  
##  3rd Qu.: 9.946   3rd Qu.: 9.809   3rd Qu.:10.355   3rd Qu.: 9.929  
##  Max.   :15.459   Max.   :13.181   Max.   :21.422   Max.   :18.191  
##       2005             2006             2007             2008       
##  Min.   : 2.846   Min.   : 0.000   Min.   : 2.674   Min.   : 0.000  
##  1st Qu.: 6.579   1st Qu.: 5.974   1st Qu.: 5.877   1st Qu.: 6.161  
##  Median : 7.791   Median : 7.315   Median : 7.291   Median : 7.198  
##  Mean   : 8.396   Mean   : 7.064   Mean   : 7.761   Mean   : 7.533  
##  3rd Qu.:10.207   3rd Qu.: 8.589   3rd Qu.: 9.830   3rd Qu.: 9.324  
##  Max.   :18.347   Max.   :12.600   Max.   :14.660   Max.   :14.562  
##       2009             2010             2011             2012       
##  Min.   : 0.000   Min.   : 0.000   Min.   : 0.000   Min.   : 0.000  
##  1st Qu.: 6.255   1st Qu.: 5.922   1st Qu.: 5.385   1st Qu.: 5.556  
##  Median : 7.103   Median : 7.305   Median : 6.633   Median : 6.709  
##  Mean   : 7.638   Mean   : 7.429   Mean   : 6.802   Mean   : 6.652  
##  3rd Qu.: 8.325   3rd Qu.: 9.413   3rd Qu.: 8.020   3rd Qu.: 7.403  
##  Max.   :27.473   Max.   :12.834   Max.   :13.373   Max.   :18.464  
##       2013             2014             2015             2016       
##  Min.   : 0.000   Min.   : 0.000   Min.   : 2.155   Min.   : 0.000  
##  1st Qu.: 5.191   1st Qu.: 5.462   1st Qu.: 5.788   1st Qu.: 6.000  
##  Median : 6.307   Median : 6.853   Median : 7.192   Median : 7.608  
##  Mean   : 6.941   Mean   : 6.627   Mean   : 7.627   Mean   : 7.118  
##  3rd Qu.: 8.884   3rd Qu.: 8.138   3rd Qu.: 9.134   3rd Qu.: 8.498  
##  Max.   :17.596   Max.   :13.206   Max.   :14.501   Max.   :13.803  
##       2017             2018             2019             2020       
##  Min.   : 0.000   Min.   : 0.000   Min.   : 2.561   Min.   : 0.000  
##  1st Qu.: 5.925   1st Qu.: 5.956   1st Qu.: 5.761   1st Qu.: 5.057  
##  Median : 7.307   Median : 6.961   Median : 7.396   Median : 7.271  
##  Mean   : 7.915   Mean   : 7.185   Mean   : 7.765   Mean   : 7.340  
##  3rd Qu.: 9.626   3rd Qu.: 8.432   3rd Qu.: 9.631   3rd Qu.: 8.965  
##  Max.   :26.893   Max.   :15.582   Max.   :13.657   Max.   :18.272  
##       2021             2022             2023             2024       
##  Min.   : 0.000   Min.   : 0.000   Min.   : 0.000   Min.   : 0.000  
##  1st Qu.: 4.209   1st Qu.: 5.226   1st Qu.: 4.726   1st Qu.: 5.370  
##  Median : 7.156   Median : 6.916   Median : 6.740   Median : 7.334  
##  Mean   : 6.389   Mean   : 6.656   Mean   : 6.580   Mean   : 6.440  
##  3rd Qu.: 8.362   3rd Qu.: 7.813   3rd Qu.: 8.464   3rd Qu.: 8.085  
##  Max.   :12.465   Max.   :13.990   Max.   :15.170   Max.   :10.964

# Transformar a formato largo
library(dplyr)
library(tidyverse)
datos2 <- Datos2
datos_largos2 <- datos2 %>%
  pivot_longer(
    cols = -Lugar,
    names_to = "Año",
    values_to = "Tasa"
  ) %>%
  mutate(
    Año = as.integer(Año))

TASA NACIONAL

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

# Filtrar solo Tasa Nacional
tasa_nacional2 <- datos_largos2 %>%
  filter(Lugar == "Nacional")

# Graficar con colores azul y turquesa + etiquetas
ggplot(tasa_nacional2, 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 mujeres)"
  ) +
  theme_minimal()

summary(tasa_nacional2)

##     Lugar                Año            Tasa      
##  Length:27          Min.   :1998   Min.   :6.484  
##  Class :character   1st Qu.:2004   1st Qu.:7.070  
##  Mode  :character   Median :2011   Median :7.262  
##                     Mean   :2011   Mean   :7.384  
##                     3rd Qu.:2018   3rd Qu.:7.784  
##                     Max.   :2024   Max.   :8.357

ANALISIS POR REGIONES

library(plotly)

# Separar nacional y ciudades
nacional2 <- datos_largos2 %>% filter(Lugar == "Nacional")
ciudades2 <- datos_largos2 %>% filter(Lugar != "Nacional")

# Crear gráfico interactivo
plot_ly() %>%
  # Línea nacional (resaltada)
  add_trace(
    data = nacional2,
    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 = ciudades2,
    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>"))
  )

## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors
## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors

ANTIOQUIA

antioquia2 <- datos_largos2 %>% filter(Lugar == "Antioquia")
summary(antioquia2)

##     Lugar                Año            Tasa      
##  Length:27          Min.   :1998   Min.   :4.490  
##  Class :character   1st Qu.:2004   1st Qu.:5.588  
##  Mode  :character   Median :2011   Median :6.060  
##                     Mean   :2011   Mean   :6.224  
##                     3rd Qu.:2018   3rd Qu.:6.973  
##                     Max.   :2024   Max.   :8.898

ARAUCA

arauca2 <- datos_largos2 %>% filter(Lugar == "Arauca")
summary(arauca2)

##     Lugar                Año            Tasa       
##  Length:27          Min.   :1998   Min.   : 3.689  
##  Class :character   1st Qu.:2004   1st Qu.: 7.246  
##  Mode  :character   Median :2011   Median : 9.191  
##                     Mean   :2011   Mean   : 9.470  
##                     3rd Qu.:2018   3rd Qu.:10.818  
##                     Max.   :2024   Max.   :14.660

ATLANTICO

atlantico2 <- datos_largos2 %>% filter(Lugar == "Atlántico")
summary(atlantico2)

##     Lugar                Año            Tasa       
##  Length:27          Min.   :1998   Min.   : 5.071  
##  Class :character   1st Qu.:2004   1st Qu.: 6.731  
##  Mode  :character   Median :2011   Median : 7.924  
##                     Mean   :2011   Mean   : 8.302  
##                     3rd Qu.:2018   3rd Qu.:10.194  
##                     Max.   :2024   Max.   :12.465

BOGOTA

bogota2 <- datos_largos2 %>% filter(Lugar == "Bogotá")
summary(bogota2)

##     Lugar                Año            Tasa      
##  Length:27          Min.   :1998   Min.   :5.228  
##  Class :character   1st Qu.:2004   1st Qu.:5.889  
##  Mode  :character   Median :2011   Median :6.481  
##                     Mean   :2011   Mean   :6.574  
##                     3rd Qu.:2018   3rd Qu.:6.941  
##                     Max.   :2024   Max.   :8.616

NORTE DE SANTANDER

Norte_Santander2 <- datos_largos2 %>% filter(Lugar == "Norte de Santander")
summary(Norte_Santander2)

##     Lugar                Año            Tasa       
##  Length:27          Min.   :1998   Min.   : 5.648  
##  Class :character   1st Qu.:2004   1st Qu.: 6.857  
##  Mode  :character   Median :2011   Median : 8.158  
##                     Mean   :2011   Mean   : 8.241  
##                     3rd Qu.:2018   3rd Qu.: 9.732  
##                     Max.   :2024   Max.   :12.069

SANTANDER

Santander2 <- datos_largos2 %>% filter(Lugar == "Santander")
summary(Santander2)

##     Lugar                Año            Tasa       
##  Length:27          Min.   :1998   Min.   : 4.480  
##  Class :character   1st Qu.:2004   1st Qu.: 6.776  
##  Mode  :character   Median :2011   Median : 7.372  
##                     Mean   :2011   Mean   : 7.406  
##                     3rd Qu.:2018   3rd Qu.: 7.876  
##                     Max.   :2024   Max.   :10.601

VALLE

valle2 <- datos_largos2 %>% filter(Lugar == "Valle del Cauca")
summary(valle2)

##     Lugar                Año            Tasa       
##  Length:27          Min.   :1998   Min.   : 7.406  
##  Class :character   1st Qu.:2004   1st Qu.: 8.271  
##  Mode  :character   Median :2011   Median : 8.591  
##                     Mean   :2011   Mean   : 8.891  
##                     3rd Qu.:2018   3rd Qu.: 9.304  
##                     Max.   :2024   Max.   :10.815

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

library(readxl)
library(tidyverse)
library(forecast)
library(tseries)

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

library(Metrics)
library(ggfortify)

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

## Registered S3 methods overwritten by 'ggfortify':
##   method                 from    
##   autoplot.Arima         forecast
##   autoplot.acf           forecast
##   autoplot.ar            forecast
##   autoplot.bats          forecast
##   autoplot.decomposed.ts forecast
##   autoplot.ets           forecast
##   autoplot.forecast      forecast
##   autoplot.stl           forecast
##   autoplot.ts            forecast
##   fitted.ar              forecast
##   fortify.ts             forecast
##   residuals.ar           forecast

# Leer datos
data <- Datos2  #FUENTE DANE

# Transformar a formato largo
data_long <- data %>%
  pivot_longer(cols = -Lugar, names_to = "Año", values_to = "Tasa") %>%
  mutate(Año = as.integer(Año)) %>%
  filter(Lugar %in% c("Nacional", "Bogotá", "Valle del Cauca", "Antioquia", 
                      "Arauca", "Atlántico", "Santander", "Norte de Santander"))

# Definir función para análisis, modelado y evaluación por ciudad
analizar_modelos <- function(df, lugar) {
  mensaje <- paste0("📊 Procesando: ", lugar)
  print(mensaje)
  
  serie <- df %>% filter(Lugar == lugar) %>% arrange(Año)
  ts_total <- ts(serie$Tasa, start = min(serie$Año), frequency = 1)
  
  # Análisis exploratorio
  autoplot(ts_total) +
    labs(title = paste("Tasa de Mortalidad -", lugar),
         x = "Año", y = "Tasa") +
    theme_minimal()

  # Estacionariedad
  print(adf.test(ts_total))  # Dickey-Fuller
  
  # Entrenamiento (1998-2015) y Validación (2016-2019)
  train <- window(ts_total, end = 2015)
  valid <- window(ts_total, start = 2016, end = 2019)
  
  # Años para predecir (solo los que pide la usuaria)
  años_futuros <- c(2020, 2021, 2022, 2023, 2024, 2025, 2026, 2027, 2028, 2029, 2030, 2031)
  h_futuro <- max(años_futuros) - 2015
  
  # ---- ARIMA
  modelo_arima <- auto.arima(train)
  pred_arima <- forecast(modelo_arima, h = h_futuro, level = 95)

  # ---- ETS
  modelo_ets <- ets(train)
  pred_ets <- forecast(modelo_ets, h = h_futuro, level = 95)

  # Subconjunto de predicciones solo para los años solicitados
  idx_pred <- (años_futuros - 2015)
  pred_arima_df <- data.frame(
    Año = años_futuros,
    Pred = pred_arima$mean[idx_pred],
    Lower = pred_arima$lower[idx_pred],
    Upper = pred_arima$upper[idx_pred],
    Modelo = "ARIMA"
  )
  pred_ets_df <- data.frame(
    Año = años_futuros,
    Pred = pred_ets$mean[idx_pred],
    Lower = pred_ets$lower[idx_pred],
    Upper = pred_ets$upper[idx_pred],
    Modelo = "ETS"
  )
  
  pred_df <- bind_rows(pred_arima_df, pred_ets_df)

  # Evaluación en set de validación
  arima_valid <- forecast(modelo_arima, h = length(valid))
  ets_valid <- forecast(modelo_ets, h = length(valid))

  errores <- tibble(
    Lugar = lugar,
    Modelo = c("ARIMA", "ETS"),
    MAE = c(mae(valid, arima_valid$mean), mae(valid, ets_valid$mean)),
    RMSE = c(rmse(valid, arima_valid$mean), rmse(valid, ets_valid$mean)),
    MAPE = c(mape(valid, arima_valid$mean)*100, mape(valid, ets_valid$mean)*100)
  )

  # Visualización
# Combinar serie original con predicciones
observado_df <- serie %>%
  select(Año, Tasa) %>%
  mutate(Modelo = "Observado")

# Crear gráfico combinado
print(
  ggplot() +
    geom_line(data = observado_df, aes(x = Año, y = Tasa, color = Modelo), size = 1.2) +
    geom_line(data = pred_df, aes(x = Año, y = Pred, color = Modelo), size = 1.2) +
    geom_ribbon(data = pred_df, aes(x = Año, ymin = Lower, ymax = Upper, fill = Modelo), 
                alpha = 0.2, linetype = "dashed") +
    scale_color_manual(values = c("Observado" = "black", "ARIMA" = "#0072B2", "ETS" = "#56B4E9")) +
    scale_fill_manual(values = c("ARIMA" = "#0072B2", "ETS" = "#56B4E9")) +
    labs(title = paste("Tasa de Mortalidad CCU-", lugar),
         x = "Año", y = "Tasa de Mortalidad",
         color = "Modelo", fill = "Modelo") +
    theme_minimal()
)

  return(list(errores = errores, predicciones = pred_df))
}


# Lista completa con ambos outputs
resultados_completos <- map(unique(data_long$Lugar), ~analizar_modelos(data_long, .x))

## [1] "📊 Procesando: Nacional"
## 
##  Augmented Dickey-Fuller Test
## 
## data:  ts_total
## Dickey-Fuller = -0.91862, Lag order = 2, p-value = 0.9329
## alternative hypothesis: stationary

## [1] "📊 Procesando: Antioquia"
## 
##  Augmented Dickey-Fuller Test
## 
## data:  ts_total
## Dickey-Fuller = -1.3938, Lag order = 2, p-value = 0.8039
## alternative hypothesis: stationary

## [1] "📊 Procesando: Atlántico"
## 
##  Augmented Dickey-Fuller Test
## 
## data:  ts_total
## Dickey-Fuller = -1.7053, Lag order = 2, p-value = 0.6849
## alternative hypothesis: stationary

## [1] "📊 Procesando: Bogotá"

## Warning in adf.test(ts_total): p-value greater than printed p-value

## 
##  Augmented Dickey-Fuller Test
## 
## data:  ts_total
## Dickey-Fuller = 0.011307, Lag order = 2, p-value = 0.99
## alternative hypothesis: stationary

## [1] "📊 Procesando: Norte de Santander"
## 
##  Augmented Dickey-Fuller Test
## 
## data:  ts_total
## Dickey-Fuller = -1.4172, Lag order = 2, p-value = 0.7949
## alternative hypothesis: stationary

## [1] "📊 Procesando: Santander"
## 
##  Augmented Dickey-Fuller Test
## 
## data:  ts_total
## Dickey-Fuller = -1.8159, Lag order = 2, p-value = 0.6427
## alternative hypothesis: stationary

## [1] "📊 Procesando: Valle del Cauca"
## 
##  Augmented Dickey-Fuller Test
## 
## data:  ts_total
## Dickey-Fuller = -2.4129, Lag order = 2, p-value = 0.4148
## alternative hypothesis: stationary

## [1] "📊 Procesando: Arauca"
## 
##  Augmented Dickey-Fuller Test
## 
## data:  ts_total
## Dickey-Fuller = -3.1504, Lag order = 2, p-value = 0.1333
## alternative hypothesis: stationary

# Extraer y combinar errores
errores_df <- map_dfr(resultados_completos, "errores")

# Extraer y combinar predicciones con el nombre del lugar
lugares <- unique(data_long$Lugar)
predicciones_df <- map2_dfr(resultados_completos, lugares, 
                            ~mutate(.x$predicciones, Lugar = .y))

# Mostrar resultados
print(errores_df)

## # A tibble: 16 × 5
##    Lugar              Modelo   MAE  RMSE  MAPE
##    <chr>              <chr>  <dbl> <dbl> <dbl>
##  1 Nacional           ARIMA  0.217 0.251  3.02
##  2 Nacional           ETS    0.223 0.257  3.11
##  3 Antioquia          ARIMA  0.656 0.664 13.0 
##  4 Antioquia          ETS    0.512 0.669  9.01
##  5 Atlántico          ARIMA  3.31  3.52  31.0 
##  6 Atlántico          ETS    3.31  3.52  31.0 
##  7 Bogotá             ARIMA  0.632 0.794  9.94
##  8 Bogotá             ETS    0.522 0.674  8.33
##  9 Norte de Santander ARIMA  2.07  2.34  24.1 
## 10 Norte de Santander ETS    1.93  2.23  22.4 
## 11 Santander          ARIMA  0.743 0.960 12.6 
## 12 Santander          ETS    0.438 0.699  7.72
## 13 Valle del Cauca    ARIMA  1.01  1.11  12.7 
## 14 Valle del Cauca    ETS    0.741 0.876  9.42
## 15 Arauca             ARIMA  1.58  2.12  13.3 
## 16 Arauca             ETS    1.58  2.22  13.0

print(predicciones_df %>% filter(Año %in% 2020:2030))

##      Año     Pred       Lower     Upper Modelo              Lugar
## 1   2020 6.892015  5.54947952  8.234550  ARIMA           Nacional
## 2   2021 6.892015  5.42134112  8.362688  ARIMA           Nacional
## 3   2022 6.892015  5.30350569  8.480523  ARIMA           Nacional
## 4   2023 6.892015  5.19382715  8.590202  ARIMA           Nacional
## 5   2024 6.892015  5.09081481  8.693214  ARIMA           Nacional
## 6   2025 6.892015  4.99338332  8.790646  ARIMA           Nacional
## 7   2026 6.892015  4.90071332  8.883316  ARIMA           Nacional
## 8   2027 6.892015  4.81216824  8.971861  ARIMA           Nacional
## 9   2028 6.892015  4.72724188  9.056787  ARIMA           Nacional
## 10  2029 6.892015  4.64552378  9.138505  ARIMA           Nacional
## 11  2030 6.892015  4.56667569  9.217353  ARIMA           Nacional
## 12  2020 6.885830  5.81207479  7.959586    ETS           Nacional
## 13  2021 6.885830  5.72289783  8.048763    ETS           Nacional
## 14  2022 6.885830  5.64008836  8.131572    ETS           Nacional
## 15  2023 6.885830  5.56245053  8.209210    ETS           Nacional
## 16  2024 6.885830  5.48912164  8.282539    ETS           Nacional
## 17  2025 6.885830  5.41945514  8.352205    ETS           Nacional
## 18  2026 6.885830  5.35295158  8.418709    ETS           Nacional
## 19  2027 6.885830  5.28921569  8.482445    ETS           Nacional
## 20  2028 6.885830  5.22792824  8.543732    ETS           Nacional
## 21  2029 6.885830  5.16882701  8.602833    ETS           Nacional
## 22  2030 6.885830  5.11169352  8.659967    ETS           Nacional
## 23  2020 5.180271  3.19196669  7.168574  ARIMA          Antioquia
## 24  2021 5.140299  3.01417532  7.266423  ARIMA          Antioquia
## 25  2022 5.164161  2.88895250  7.439370  ARIMA          Antioquia
## 26  2023 5.149916  2.74601045  7.553822  ARIMA          Antioquia
## 27  2024 5.158420  2.62605013  7.690791  ARIMA          Antioquia
## 28  2025 5.153343  2.50233183  7.804355  ARIMA          Antioquia
## 29  2026 5.156374  2.38974516  7.923003  ARIMA          Antioquia
## 30  2027 5.154565  2.27814590  8.030984  ARIMA          Antioquia
## 31  2028 5.155645  2.17279315  8.138497  ARIMA          Antioquia
## 32  2029 5.155000  2.06977840  8.240222  ARIMA          Antioquia
## 33  2030 5.155385  1.97085498  8.339915  ARIMA          Antioquia
## 34  2020 4.267085  3.63320973  4.900961    ETS          Antioquia
## 35  2021 4.088578  3.48105442  4.696102    ETS          Antioquia
## 36  2022 3.910071  3.32883464  4.491307    ETS          Antioquia
## 37  2023 3.731564  3.17653541  4.286592    ETS          Antioquia
## 38  2024 3.553057  3.02413933  4.081974    ETS          Antioquia
## 39  2025 3.374550  2.87162602  3.877473    ETS          Antioquia
## 40  2026 3.196042  2.71897129  3.673113    ETS          Antioquia
## 41  2027 3.017535  2.56614609  3.468924    ETS          Antioquia
## 42  2028 2.839028  2.41311511  3.264941    ETS          Antioquia
## 43  2029 2.660521  2.25983489  3.061207    ETS          Antioquia
## 44  2030 2.482014  2.10625134  2.857776    ETS          Antioquia
## 45  2020 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 46  2021 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 47  2022 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 48  2023 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 49  2024 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 50  2025 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 51  2026 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 52  2027 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 53  2028 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 54  2029 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 55  2030 7.022771  4.73074453  9.314797  ARIMA          Atlántico
## 56  2020 7.022829  4.66014504  9.385512    ETS          Atlántico
## 57  2021 7.022829  4.66014503  9.385512    ETS          Atlántico
## 58  2022 7.022829  4.66014501  9.385512    ETS          Atlántico
## 59  2023 7.022829  4.66014500  9.385512    ETS          Atlántico
## 60  2024 7.022829  4.66014499  9.385512    ETS          Atlántico
## 61  2025 7.022829  4.66014498  9.385512    ETS          Atlántico
## 62  2026 7.022829  4.66014496  9.385512    ETS          Atlántico
## 63  2027 7.022829  4.66014495  9.385512    ETS          Atlántico
## 64  2028 7.022829  4.66014494  9.385512    ETS          Atlántico
## 65  2029 7.022829  4.66014493  9.385512    ETS          Atlántico
## 66  2030 7.022829  4.66014492  9.385512    ETS          Atlántico
## 67  2020 5.464074  2.78192963  8.146219  ARIMA             Bogotá
## 68  2021 5.464074  2.52593204  8.402216  ARIMA             Bogotá
## 69  2022 5.464074  2.29051796  8.637630  ARIMA             Bogotá
## 70  2023 5.464074  2.07139988  8.856748  ARIMA             Bogotá
## 71  2024 5.464074  1.86559968  9.062549  ARIMA             Bogotá
## 72  2025 5.464074  1.67094901  9.257199  ARIMA             Bogotá
## 73  2026 5.464074  1.48581094  9.442337  ARIMA             Bogotá
## 74  2027 5.464074  1.30891374  9.619234  ARIMA             Bogotá
## 75  2028 5.464074  1.13924608  9.788902  ARIMA             Bogotá
## 76  2029 5.464074  0.97598796  9.952160  ARIMA             Bogotá
## 77  2030 5.464074  0.81846359 10.109685  ARIMA             Bogotá
## 78  2020 5.683648  4.55748455  6.809812    ETS             Bogotá
## 79  2021 5.683648  4.49978098  6.867516    ETS             Bogotá
## 80  2022 5.683648  4.44470495  6.922592    ETS             Bogotá
## 81  2023 5.683648  4.39192028  6.975376    ETS             Bogotá
## 82  2024 5.683648  4.34115660  7.026140    ETS             Bogotá
## 83  2025 5.683648  4.29219264  7.075104    ETS             Bogotá
## 84  2026 5.683648  4.24484461  7.122452    ETS             Bogotá
## 85  2027 5.683648  4.19895784  7.168339    ETS             Bogotá
## 86  2028 5.683648  4.15440073  7.212896    ETS             Bogotá
## 87  2029 5.683648  4.11106022  7.256236    ETS             Bogotá
## 88  2030 5.683648  4.06883830  7.298458    ETS             Bogotá
## 89  2020 6.058293  0.81395450 11.302632  ARIMA Norte de Santander
## 90  2021 6.082219  0.46208161 11.702357  ARIMA Norte de Santander
## 91  2022 6.068489  0.05528556 12.081693  ARIMA Norte de Santander
## 92  2023 6.076368 -0.28341300 12.436149  ARIMA Norte de Santander
## 93  2024 6.071847 -0.62868631 12.772380  ARIMA Norte de Santander
## 94  2025 6.074441 -0.94368266 13.092565  ARIMA Norte de Santander
## 95  2026 6.072952 -1.25265104 13.398556  ARIMA Norte de Santander
## 96  2027 6.073807 -1.54486352 13.692477  ARIMA Norte de Santander
## 97  2028 6.073317 -1.82867253 13.975306  ARIMA Norte de Santander
## 98  2029 6.073598 -2.10127874 14.248474  ARIMA Norte de Santander
## 99  2030 6.073436 -2.36585196 14.512725  ARIMA Norte de Santander
## 100 2020 6.189644  2.59306422  9.786224    ETS Norte de Santander
## 101 2021 6.189644  2.35499546 10.024293    ETS Norte de Santander
## 102 2022 6.189644  2.12845929 10.250829    ETS Norte de Santander
## 103 2023 6.189644  1.91159801 10.467690    ETS Norte de Santander
## 104 2024 6.189644  1.70298415 10.676304    ETS Norte de Santander
## 105 2025 6.189644  1.50149305 10.877795    ETS Norte de Santander
## 106 2026 6.189644  1.30622010 11.073068    ETS Norte de Santander
## 107 2027 6.189644  1.11642497 11.262863    ETS Norte de Santander
## 108 2028 6.189644  0.93149276 11.447795    ETS Norte de Santander
## 109 2029 6.189644  0.75090618 11.628382    ETS Norte de Santander
## 110 2030 6.189644  0.57422518 11.805063    ETS Norte de Santander
## 111 2020 7.204415  0.50750000 13.901331  ARIMA          Santander
## 112 2021 7.204415 -0.13168786 14.540519  ARIMA          Santander
## 113 2022 7.204415 -0.71948177 15.128313  ARIMA          Santander
## 114 2023 7.204415 -1.26658700 15.675418  ARIMA          Santander
## 115 2024 7.204415 -1.78043946 16.189270  ARIMA          Santander
## 116 2025 7.204415 -2.26645321 16.675284  ARIMA          Santander
## 117 2026 7.204415 -2.72871540 17.137546  ARIMA          Santander
## 118 2027 7.204415 -3.17040136 17.579232  ARIMA          Santander
## 119 2028 7.204415 -3.59403625 18.002867  ARIMA          Santander
## 120 2029 7.204415 -4.00166747 18.410498  ARIMA          Santander
## 121 2030 7.204415 -4.39498237 18.803813  ARIMA          Santander
## 122 2020 6.805061  3.36284736 10.247275    ETS          Santander
## 123 2021 6.805061  3.21203740 10.398085    ETS          Santander
## 124 2022 6.805061  3.06730735 10.542815    ETS          Santander
## 125 2023 6.805061  2.92797624 10.682146    ETS          Santander
## 126 2024 6.805061  2.79348151 10.816641    ETS          Santander
## 127 2025 6.805061  2.66335195 10.946771    ETS          Santander
## 128 2026 6.805061  2.53718826 11.072934    ETS          Santander
## 129 2027 6.805061  2.41464854 11.195474    ETS          Santander
## 130 2028 6.805061  2.29543736 11.314685    ETS          Santander
## 131 2029 6.805061  2.17929737 11.430825    ETS          Santander
## 132 2030 6.805061  2.06600276 11.544120    ETS          Santander
## 133 2020 9.205424  5.51921328 12.891634  ARIMA    Valle del Cauca
## 134 2021 9.205424  5.16738251 13.243465  ARIMA    Valle del Cauca
## 135 2022 9.205424  4.84384073 13.567006  ARIMA    Valle del Cauca
## 136 2023 9.205424  4.54269538 13.868152  ARIMA    Valle del Cauca
## 137 2024 9.205424  4.25985348 14.150994  ARIMA    Valle del Cauca
## 138 2025 9.205424  3.99233496 14.418512  ARIMA    Valle del Cauca
## 139 2026 9.205424  3.73789011 14.672957  ARIMA    Valle del Cauca
## 140 2027 9.205424  3.49477112 14.916076  ARIMA    Valle del Cauca
## 141 2028 9.205424  3.26158805 15.149259  ARIMA    Valle del Cauca
## 142 2029 9.205424  3.03721394 15.373633  ARIMA    Valle del Cauca
## 143 2030 9.205424  2.82072003 15.590127  ARIMA    Valle del Cauca
## 144 2020 8.933744  6.74547285 11.122014    ETS    Valle del Cauca
## 145 2021 8.933744  6.59398259 11.273504    ETS    Valle del Cauca
## 146 2022 8.933744  6.45141699 11.416070    ETS    Valle del Cauca
## 147 2023 8.933744  6.31631669 11.551170    ETS    Valle del Cauca
## 148 2024 8.933744  6.18757907 11.679908    ETS    Valle del Cauca
## 149 2025 8.933744  6.06434701 11.803140    ETS    Valle del Cauca
## 150 2026 8.933744  5.94593866 11.921548    ETS    Valle del Cauca
## 151 2027 8.933744  5.83180102 12.035686    ETS    Valle del Cauca
## 152 2028 8.933744  5.72147830 12.146009    ETS    Valle del Cauca
## 153 2029 8.933744  5.61458957 12.252897    ETS    Valle del Cauca
## 154 2030 8.933744  5.51081260 12.356674    ETS    Valle del Cauca
## 155 2020 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 156 2021 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 157 2022 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 158 2023 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 159 2024 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 160 2025 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 161 2026 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 162 2027 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 163 2028 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 164 2029 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 165 2030 9.673201  3.51534554 15.831057  ARIMA             Arauca
## 166 2020 9.461260  3.09826885 15.824252    ETS             Arauca
## 167 2021 9.461260  3.09826882 15.824252    ETS             Arauca
## 168 2022 9.461260  3.09826879 15.824252    ETS             Arauca
## 169 2023 9.461260  3.09826876 15.824252    ETS             Arauca
## 170 2024 9.461260  3.09826873 15.824252    ETS             Arauca
## 171 2025 9.461260  3.09826869 15.824252    ETS             Arauca
## 172 2026 9.461260  3.09826866 15.824252    ETS             Arauca
## 173 2027 9.461260  3.09826863 15.824252    ETS             Arauca
## 174 2028 9.461260  3.09826860 15.824252    ETS             Arauca
## 175 2029 9.461260  3.09826857 15.824252    ETS             Arauca
## 176 2030 9.461260  3.09826853 15.824252    ETS             Arauca

Con relacion al Test Dickey-Fuller para la tasa nacional (hipotesis nula la serie no es estacionaria) dado que el p-valor es mucho mayor (0.9074) al umbral usual de significancia (0.05) no se rechaza la hipótesis nula, es decir no es estacionaria. No se puede usar ARIMA a menos que se transforme diferenciando la serie. Solo Arauca es estacionaria.

# Extraer la serie para un lugar específico, por ejemplo "Bogotá"
serie_bogota <- data_long %>%
  filter(Lugar == "Bogotá") %>%
  arrange(Año)

# Crear objeto ts fuera de la función
ts_total <- ts(serie_bogota$Tasa, start = min(serie_bogota$Año), frequency = 1)

# Diferenciar y aplicar prueba ADF
ts_diff <- diff(ts_total)
adf.test(ts_diff)

## 
##  Augmented Dickey-Fuller Test
## 
## data:  ts_diff
## Dickey-Fuller = -3.9116, Lag order = 2, p-value = 0.02774
## alternative hypothesis: stationary

#vuelve a ejecutar el test Dickey-Fuller para verificar si la diferencia sí la vuelve estacionaria

Este test se utiliza para evaluar si una serie temporal es estacionaria, es decir, si sus propiedades estadísticas (media, varianza, autocorrelación) no cambian con el tiempo. El p-valor es 0.02774, que es menor a 0.05, por tanto, se rechaza la hipótesis nula al 95% de confianza.Esto significa que la serie diferenciada sí es estacionaria para Bogotá cuando se hace una diferenciación.

library(ggplot2)
library(tibble)

# Crear data frame para graficar la serie diferenciada
df_diff <- tibble(
  Año = time(ts_diff),
  Diferencia = as.numeric(ts_diff)
)

# Gráfico de la serie diferenciada
ggplot(df_diff, aes(x = Año, y = Diferencia)) +
  geom_line(color = "#0072B2", size = 1) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray40") +
  labs(
    title = "Serie Diferenciada (Cambio anual en la Tasa de Bogota)",
    x = "Año",
    y = "Diferencia (Tasa_t - Tasa_t-1)"
  ) +
  theme_minimal()

## Don't know how to automatically pick scale for object of type <ts>. Defaulting
## to continuous.

library(forecast)
library(ggplot2)
library(tibble)
library(dplyr)

# 1. Crear la serie temporal original
serie <- data_long %>%
  filter(Lugar == "Bogotá") %>%  # Cambia "Bogotá" por el lugar deseado
  arrange(Año)

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

# 2. Aplicar diferenciación (opcional para visualización)
ts_diff <- diff(ts_total)

# 3. Ajustar modelo ARIMA con diferenciación automática (detecta d = 1)
modelo_arima <- auto.arima(ts_total)

# 4. Generar predicciones desde 2020 hasta 2030
año_inicio_pred <- 2020
año_fin_pred <- 2030
años_existentes <- time(ts_total)
año_último <- max(años_existentes)

h <- año_fin_pred - año_último

pred_arima <- forecast(modelo_arima, h = h, level = 95)

# 5. Crear data frame para graficar
pred_df <- tibble(
  Año = (año_último + 1):(año_último + h),
  Pred = as.numeric(pred_arima$mean),
  Lower = as.numeric(pred_arima$lower),
  Upper = as.numeric(pred_arima$upper)
)

# Observado
observado_df <- tibble(
  Año = as.numeric(time(ts_total)),
  Tasa = as.numeric(ts_total)
)

# 6. Gráfico
ggplot() +
  geom_line(data = observado_df, aes(x = Año, y = Tasa), color = "black", size = 1.2) +
  geom_line(data = pred_df, aes(x = Año, y = Pred), color = "#0072B2", size = 1.2) +
  geom_ribbon(data = pred_df, aes(x = Año, ymin = Lower, ymax = Upper),
              fill = "#0072B2", alpha = 0.2) +
  labs(
    title = "Predicción ARIMA de Tasa de Mortalidad (2020–2030)",
    x = "Año",
    y = "Tasa",
    caption = "Modelo ajustado con auto.arima sobre serie diferenciada"
  ) +
  theme_minimal()

# --- Crear data frame con predicciones
pred_df <- tibble(
  Año = (año_último + 1):(año_último + h),
  Pred = as.numeric(pred_arima$mean),
  Lower = as.numeric(pred_arima$lower),
  Upper = as.numeric(pred_arima$upper)
)

# --- Ver el data frame
print(pred_df)

## # A tibble: 6 × 4
##     Año  Pred Lower Upper
##   <int> <dbl> <dbl> <dbl>
## 1  2025  7.78  6.38  9.19
## 2  2026  7.37  5.72  9.03
## 3  2027  7.11  5.37  8.86
## 4  2028  6.95  5.17  8.73
## 5  2029  6.85  5.06  8.64
## 6  2030  6.79  4.99  8.58