1. Definición de la serie de tiempo y componentes

La serie de tiempo elegida es la Tasa Representativa del Mercado (TRM) semanal del par peso colombiano–Dólar estadounidense, medida cada viernes desde 2016 hasta 2025. Este dataset cumple con las condiciones de serie de tiempo, debido a que:

Las observaciones están ordenadas cronológicamente en intervalos uniformes (una vez por semana)
Permite analizar la evolución de la TRM a lo largo del tiempo, adicionalmente permite análizar caracteristicas como tendencias, ciclos estacionales e irregularidad
Son datos con componente de aleatoriedad.

# Carga de datos
datos <- read.csv(
  "C:/Users/almun/OneDrive - Universidad Nacional de Colombia/Escritorio/Undecimo semestre/Metodos cuantitativos/Taller 2 predictivo/trm.csv",
  sep = ";",
  stringsAsFactors = FALSE
)

datos$fecha <- as.Date(datos$fecha, format = "%d/%m/%Y")

# Partición: entrenamiento (todos menos últimos 3) y prueba (últimos 3)

N_total  <- nrow(datos)
train_df <- datos[1:(N_total-3), ]
test_df  <- datos[(N_total-2):N_total, ]

# Serie de tiempo semanal (frecuencia = 52)
start_sem <- c(year(min(train_df$fecha)), isoweek(min(train_df$fecha)))
trm_ts    <- ts(train_df$trm, start = start_sem, frequency = 52)

# Descomposición STL
stl_dec <- stl(trm_ts, s.window = "periodic")
# Guardamos componentes y mostramos primeras 6 filas
componentes <- as_tibble(stl_dec$time.series)
head(componentes, 6)

## # A tibble: 6 × 3
##   seasonal trend remainder
##      <dbl> <dbl>     <dbl>
## 1  -28.5   3046.      53.3
## 2   -2.09  3042.      59.9
## 3   16.8   3039.     108. 
## 4   -0.577 3036.     153. 
## 5  -29.2   3033.      57.6
## 6  -50.2   3029.      23.6

2. Pronósticos y tablas comparativas

Horizonte de pronóstico: h = 3 (últimas 3 semanas).

# 2. Pronósticos y tablas comparativas (versión sin accuracy())
#
# En este bloque hacemos h = 3 predicciones, construimos las tablas
# de Fecha / Real / Predicción y calculamos manualmente:
#   RMSE = sqrt(mean((pred - real)^2))
#   MAE  = mean(abs(pred - real))
#   MAPE = mean(abs((pred - real) / real)) * 100
# Guardamos cada métrica en metrics_list para el resumen final.

h <- 3
fechas_test <- test_df$fecha
reales      <- test_df$trm
metrics_list <- list()

procesar_modelo <- function(nombre, fc_obj = NULL, preds = NULL) {
  if (!is.null(fc_obj) && inherits(fc_obj, "forecast")) {
    estimados <- as.numeric(fc_obj$mean)
  } else if (!is.null(preds)) {
    estimados <- as.numeric(preds)
  } else {
    stop("Debe proveer un objeto 'forecast' o un vector 'preds'.")
  }
  errores <- estimados - reales
  rmse  <- sqrt(mean(errores^2))
  mae   <- mean(abs(errores))
  mape  <- mean(abs(errores / reales)) * 100

  tabla <- tibble(
    Modelo     = nombre,
    Fecha      = fechas_test,
    Real       = reales,
    Predicción = round(estimados, 2),
    RMSE       = round(rmse,  2),
    MAE        = round(mae,   2),
    MAPE       = round(mape,  2)
  )
  cat("\n### Modelo:", nombre, "\n")
  print(tabla)

  metrics_list[[nombre]] <<- c(RMSE = rmse, MAE = mae, MAPE = mape)
}

# 2.1 Promedios Móviles
ma_fc <- forecast(ma(trm_ts, order = 8), h = h)
procesar_modelo("Promedios Móviles", fc_obj = ma_fc)

## 
## ### Modelo: Promedios Móviles 
## # A tibble: 3 × 7
##   Modelo            Fecha       Real Predicción  RMSE   MAE  MAPE
##   <chr>             <date>     <dbl>      <dbl> <dbl> <dbl> <dbl>
## 1 Promedios Móviles 2025-04-04 4274.      4095.  202.  198.   4.6
## 2 Promedios Móviles 2025-04-11 4338.      4085.  202.  198.   4.6
## 3 Promedios Móviles 2025-04-25 4240.      4080.  202.  198.   4.6

# 2.2 Suavización Exponencial Simple (SES)
ses_fc <- ses(trm_ts, h = h)
procesar_modelo("SES", fc_obj = ses_fc)

## 
## ### Modelo: SES 
## # A tibble: 3 × 7
##   Modelo Fecha       Real Predicción  RMSE   MAE  MAPE
##   <chr>  <date>     <dbl>      <dbl> <dbl> <dbl> <dbl>
## 1 SES    2025-04-04 4274.      4191.  101.  92.8  2.16
## 2 SES    2025-04-11 4338.      4191.  101.  92.8  2.16
## 3 SES    2025-04-25 4240.      4191.  101.  92.8  2.16

# 2.3 Índices Estacionales (CES simple)
ces_fc <- forecast(ces(trm_ts, h = h, seasonality = "simple"), h = h)
procesar_modelo("CES Simple", fc_obj = ces_fc)

## 
## ### Modelo: CES Simple 
## # A tibble: 3 × 7
##   Modelo     Fecha       Real Predicción  RMSE   MAE  MAPE
##   <chr>      <date>     <dbl>      <dbl> <dbl> <dbl> <dbl>
## 1 CES Simple 2025-04-04 4274.      4317.  72.9  57.8  1.36
## 2 CES Simple 2025-04-11 4338.      4351.  72.9  57.8  1.36
## 3 CES Simple 2025-04-25 4240.      4358.  72.9  57.8  1.36

# 2.4 Regresiones Polinómicas con I(): 
Tiempo <- seq_along(trm_ts)
nuevos <- data.frame(Tiempo = length(trm_ts) + seq_len(h))

# Lineal
mod_lin <- lm(trm_ts ~ Tiempo)
fc_lin  <- forecast(mod_lin, newdata = nuevos)
procesar_modelo("Regresión Lineal", fc_obj = fc_lin)

## 
## ### Modelo: Regresión Lineal 
## # A tibble: 3 × 7
##   Modelo           Fecha       Real Predicción  RMSE   MAE  MAPE
##   <chr>            <date>     <dbl>      <dbl> <dbl> <dbl> <dbl>
## 1 Regresión Lineal 2025-04-04 4274.      4516.  240.  236.  5.51
## 2 Regresión Lineal 2025-04-11 4338.      4520.  240.  236.  5.51
## 3 Regresión Lineal 2025-04-25 4240.      4524.  240.  236.  5.51

# Cuadrático
mod_cua <- lm(trm_ts ~ Tiempo + I(Tiempo^2))
fc_cua <- forecast(mod_cua, newdata = nuevos)
procesar_modelo("Regresión Cuadrática", fc_obj = fc_cua)

## 
## ### Modelo: Regresión Cuadrática 
## # A tibble: 3 × 7
##   Modelo               Fecha       Real Predicción  RMSE   MAE  MAPE
##   <chr>                <date>     <dbl>      <dbl> <dbl> <dbl> <dbl>
## 1 Regresión Cuadrática 2025-04-04 4274.      4313.  51.4  46.4  1.09
## 2 Regresión Cuadrática 2025-04-11 4338.      4315.  51.4  46.4  1.09
## 3 Regresión Cuadrática 2025-04-25 4240.      4316.  51.4  46.4  1.09

# Cúbico
mod_cub <- lm(trm_ts ~ Tiempo + I(Tiempo^2) + I(Tiempo^3))
fc_cub <- forecast(mod_cub, newdata = nuevos)
procesar_modelo("Regresión Cúbica", fc_obj = fc_cub)

## 
## ### Modelo: Regresión Cúbica 
## # A tibble: 3 × 7
##   Modelo           Fecha       Real Predicción  RMSE   MAE  MAPE
##   <chr>            <date>     <dbl>      <dbl> <dbl> <dbl> <dbl>
## 1 Regresión Cúbica 2025-04-04 4274.      3957.  338.  336.  7.83
## 2 Regresión Cúbica 2025-04-11 4338.      3948.  338.  336.  7.83
## 3 Regresión Cúbica 2025-04-25 4240.      3939.  338.  336.  7.83

# 2.5 Análisis de Correlación TRM ~ Brent
mod_corr <- lm(trm ~ brent, data = train_df)
pred_corr <- predict(mod_corr, newdata = test_df)
procesar_modelo("Correlación TRM~Brent", preds = pred_corr)

## 
## ### Modelo: Correlación TRM~Brent 
## # A tibble: 3 × 7
##   Modelo                Fecha       Real Predicción  RMSE   MAE  MAPE
##   <chr>                 <date>     <dbl>      <dbl> <dbl> <dbl> <dbl>
## 1 Correlación TRM~Brent 2025-04-04 4274.      3724.  637.  632.  14.8
## 2 Correlación TRM~Brent 2025-04-11 4338.      3603.  637.  632.  14.8
## 3 Correlación TRM~Brent 2025-04-25 4240.      3628.  637.  632.  14.8

# 2.6 Modelo ARIMA automático
mod_arima <- auto.arima(trm_ts)
fc_arima <- forecast(mod_arima, h = h)
procesar_modelo("ARIMA", fc_obj = fc_arima)

## 
## ### Modelo: ARIMA 
## # A tibble: 3 × 7
##   Modelo Fecha       Real Predicción  RMSE   MAE  MAPE
##   <chr>  <date>     <dbl>      <dbl> <dbl> <dbl> <dbl>
## 1 ARIMA  2025-04-04 4274.      4201.  98.0  89.3  2.08
## 2 ARIMA  2025-04-11 4338.      4193.  98.0  89.3  2.08
## 3 ARIMA  2025-04-25 4240.      4190.  98.0  89.3  2.08

3. Tabla resumen de métricas

Realizamos un resumen de las metricas

metrics_df <- bind_rows(
  lapply(names(metrics_list), function(m) {
    tibble(
      Modelo = m,
      RMSE   = round(metrics_list[[m]]["RMSE"], 2),
      MAE    = round(metrics_list[[m]]["MAE"], 2),
      MAPE   = round(metrics_list[[m]]["MAPE"], 2)
    )
  })
)
print(metrics_df)

## # A tibble: 8 × 4
##   Modelo                 RMSE   MAE  MAPE
##   <chr>                 <dbl> <dbl> <dbl>
## 1 Promedios Móviles     202.  198.   4.6 
## 2 SES                   101.   92.8  2.16
## 3 CES Simple             72.9  57.8  1.36
## 4 Regresión Lineal      240.  236.   5.51
## 5 Regresión Cuadrática   51.4  46.4  1.09
## 6 Regresión Cúbica      338.  336.   7.83
## 7 Correlación TRM~Brent 637.  632.  14.8 
## 8 ARIMA                  98.0  89.3  2.08

4. Gráficos de Pronóstico

Promedios Móviles

## SES

## CES Simple

## Regresión Lineal

## Regresión Cuadrática

## Regresión Cúbica

## Correlación TRM~Brent

## ARIMA automático

5. Conlcusión

Para nuestro ejercicio escogimos el modelo de Regresión Cuadrática como el que se ajusta más a nuestras necesidades (predición de la TRM semanal), porque en el conjunto de prueba alcanzó las métricas más bajas de todos:

RMSE = 51.36

MAE = 46.44

MAPE = 1.09 %

Estos valores nos indican que, en promdio, sus predicciones se desvían en menor medida de los datos reales y capturan mejor la forma no lineal de nuestra serie de tiempo

No escogimos el modelo con el segundo mejor desempeño,CES Simple, con RMSE = 72.88, MAE = 57.84 y MAPE = 1.36% porque todos sus errores son sensiblemente mayores: su MAPE es 0.27 puntos porcentuales superior y sus errores absolutos (RMSE/MAE) rondan entre 10 y 20 unidades de TRM más, lo cual resulta en un peor pronostico.

# Grafica del ultimo año de nuestra serie, incluyendo las predicicones y los datos reales 

# Definimos el ultimo año
fecha_max <- max(datos$fecha)
fecha_inicio <- fecha_max - years(1)
df_ult_ano <- datos %>% 
  filter(fecha >= fecha_inicio)

# Predicciones del mejor modelo (Regresión Cuadrática)
df_pred <- tibble(
  fecha = fechas_test,
  Pred   = as.numeric(fc_cua$mean)
)

ggplot(df_ult_ano, aes(x = fecha, y = trm)) +
  geom_line(color = "steelblue", size = 0.8) +
  geom_point(data = df_pred, aes(x = fecha, y = Pred),
             color = "firebrick", size = 3) +
  labs(
    title = "TRM Semanal: Último Año y Pronósticos",
    x     = "Fecha",
    y     = "TRM"
  ) +
  theme_minimal()

Taller 2 - Predicción TRM

Lucio Alfonso Muñoz Adarme, Edna Geraldine Cercado de la Fuente, Laura Valentina Martinez Gomez

2025-05-07