Series de Tiempo para tasas de descuento de enero 2021 a noviembre de 2025

# Se crean dos variables adicionales de año (Year) y Mes (Month) para generar una gráfica que compara las series por mes.

Montos$Year <- factor(format(Montos$Fecha, "%Y"), levels = sort(unique(format(Montos$Fecha, "%Y")), decreasing =
T))

#Se crean los datos para el primer modelo con formato de series de tiempo
montos.ts <- ts(Montos[, 2], start = 2022, freq = 52)
descuento.ts <- ts(Descuento[, 2], start = 2022, freq = 52)

plot.montos<-
autoplot(montos.ts)+scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6))+
ylab("Millones de pesos") + xlab("Semanas") +
ggtitle("Ventas de Certificados de la Tesorería 28 días,\n  enero 2022 a noviembre 2025")+theme_light()

plot.descuento<-
autoplot(descuento.ts)+ylab("Tasa de descuento") + xlab("Semanas") +
ggtitle("Tasas de descuento de Certificados de la Tesorería 28 días,\n  enero 2022 a noviembre 2025")+
theme_light()

plot.montos/plot.descuento

ggplot(Descuento, aes(SF116766))+geom_histogram(stat = "bin",fill="darkblue")+ggtitle("Cetes a 28 días, enero 2022 a noviembre 2025")+theme_light()+xlab("Tasas de descuento")+ylab("Frecuencias")

#Prueba de Dickey-Fuller para verificación estacionaridad de la serie

#H0: La series es no estacionaria 
adf.test(descuento.ts)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  descuento.ts
## Dickey-Fuller = -2.1104, Lag order = 5, p-value = 0.5298
## alternative hypothesis: stationary
acf(Descuento$SF116766)

#Se el operador de diferencia
descuento.diff<-diff(Descuento$SF116766,1)

adf.test(na.omit(descuento.diff))
## 
##  Augmented Dickey-Fuller Test
## 
## data:  na.omit(descuento.diff)
## Dickey-Fuller = -5.3305, Lag order = 5, p-value = 0.01
## alternative hypothesis: stationary
acf(descuento.diff, main="ACF", na.action = na.pass)

pacf(descuento.diff, main="PACF",na.action = na.pass)

#Se usará un modelo ARIMA y un modelo SARIMA

auto.arima(descuento.ts, seasonal = FALSE)
## Series: descuento.ts 
## ARIMA(1,2,2) 
## 
## Coefficients:
##          ar1      ma1     ma2
##       0.1617  -1.5399  0.6074
## s.e.  0.1298   0.1020  0.1002
## 
## sigma^2 = 0.01829:  log likelihood = 116.97
## AIC=-225.93   AICc=-225.73   BIC=-212.72
auto.arima(descuento.ts, seasonal = TRUE)
## Series: descuento.ts 
## ARIMA(3,2,2)(1,0,0)[52] 
## 
## Coefficients:
##           ar1      ar2      ar3      ma1      ma2    sar1
##       -0.5458  -0.3305  -0.2452  -0.8177  -0.0386  0.1057
## s.e.   0.4059   0.1839   0.0990   0.4208   0.3862  0.0913
## 
## sigma^2 = 0.01811:  log likelihood = 119.18
## AIC=-224.36   AICc=-223.78   BIC=-201.24

El orden de un proceso autorregresivo \(AR(p)\)

La función de autocorrelación parcial ACP refleja características que dependen del orden proceso y del tipo de parámetros involucrados. La función de autocorrelación parcial es el equivalente a la ACF para determinar el orden de proceso autorregresivo \(AR(p)\).

En términos de modelos de regresión lineales, la autocorrelación parcial se usa cuando se quiere cuantificar la correlación entre \(Y\) y \(Z\) sin considerar a \(X\) y se calcula como

\[\rho_{YZ\backslash X}=\frac{\rho_{YZ}-\rho_{YX}\rho_{XZ}}{\sqrt{1-\rho^2_{YX}}\sqrt{1-\rho^2_{XZ}}}\]

Consideraciones acerca de la función de autocorrelación parcial

Modelos a evaluar

  • Modelo ARIMA sin componente temporal
  • Modelo SARIMA con componente temporal
  • Modelo de Holt-Winter

Se tienen 203 datos, se usarán los datos de 2022 a 2025 (aproximadamente 80% de los datos) para el modelo de entrenamiento

decompose(descuento.ts) %>% plot()

auto.arima(descuento.ts, seasonal = FALSE)
## Series: descuento.ts 
## ARIMA(1,2,2) 
## 
## Coefficients:
##          ar1      ma1     ma2
##       0.1617  -1.5399  0.6074
## s.e.  0.1298   0.1020  0.1002
## 
## sigma^2 = 0.01829:  log likelihood = 116.97
## AIC=-225.93   AICc=-225.73   BIC=-212.72
entrena.descuento <- window(descuento.ts, start = 2022, end = c(2025, 7))

nValid <- 40
 nTrain <- length(descuento.ts) - nValid
 train.ts <- window(descuento.ts, start = c(2022, 1), end = c(2022, nTrain))
 valid.ts <- window(descuento.ts, start = c(2022, nTrain + 1), end = c(2022, nTrain + nValid))
 descuento.train.HW <-  HoltWinters(train.ts)
 descuento.train.HW.pred <- forecast(descuento.train.HW, h = nValid, level = 0)
 plot(descuento.train.HW.pred, ylim = c(3, 12),  ylab = "Tasa de descuento", xlab = "Tiempo", bty = "l", xaxt = "n", xlim = c(2021,2025+(7/52)), main = "Modelo de Holt-Winters", flty = 2)
 axis(1, at = seq(2022, 2025, 1), labels = format(seq(2022, 2025, 1)))
 lines(descuento.train.HW.pred$fitted, lwd = 2)
 lines(valid.ts)

 descuento.train.ARIMA <-  arima(train.ts, order = c(1,2,2))
 descuento.train.ARIMA.pred <- forecast(descuento.train.ARIMA, h = nValid, level = 0)
 plot(descuento.train.ARIMA.pred, ylim = c(3, 12),  ylab = "Tasa de descuento", xlab = "Tiempo", bty = "l", xaxt = "n", xlim = c(2022,2025+(7/52)), main = "Modelo de ARIMA(1,2,2)", flty = 2)
 axis(1, at = seq(2022, 2025, 1), labels = format(seq(2022, 2025, 1)))
 lines(descuento.train.ARIMA.pred$fitted, lwd = 2)
 lines(valid.ts)

 descuento.train.SARIMA <-  arima(train.ts, order = c(3,2,2), seasonal = list(order = c(0,1,1)) )
 descuento.train.SARIMA.pred <- forecast(descuento.train.SARIMA, h = nValid, level = 0)
 plot(descuento.train.SARIMA.pred, ylim = c(3, 12),  ylab = "Tasa de descuento", xlab = "Tiempo", bty = "l",xaxt = "n", xlim = c(2022,2025+(7/52)), main = "Modelo de SARIMA(3,2,2)[1,0,0]", flty = 2)
 axis(1, at = seq(2022, 2025, 1), labels = format(seq(2022, 2025, 1)))
 lines(descuento.train.SARIMA.pred$fitted, lwd = 2)
 lines(valid.ts)

Comparación de los modelos

autoplot(descuento.ts) +
  autolayer(descuento.train.HW.pred, series="Holt-Winters", PI=FALSE) +
   autolayer(descuento.train.ARIMA.pred, series="ARIMA(1,2,2)", PI=FALSE) +
   autolayer(descuento.train.SARIMA.pred, series="SARIMA(3,2,2)[1,0,0]", PI=FALSE) +
   xlab("Tiempo") + ylab("Tasa de descuento") +
   ggtitle("Predicciones de tasas de descuento CETES 28 de diciembre 2024 a noviembre 2024") +
   guides(colour=guide_legend(title="Periodo usado\n para predicción"))+
   theme_linedraw()

checkresiduals(descuento.train.HW)

## 
##  Ljung-Box test
## 
## data:  Residuals from HoltWinters
## Q* = 4.1688, df = 22, p-value = 1
## 
## Model df: 0.   Total lags used: 22
checkresiduals(descuento.train.ARIMA)

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(1,2,2)
## Q* = 46.235, df = 30, p-value = 0.0295
## 
## Model df: 3.   Total lags used: 33
checkresiduals(descuento.train.SARIMA)

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(3,2,2)(0,1,1)[52]
## Q* = 18.782, df = 27, p-value = 0.8778
## 
## Model df: 6.   Total lags used: 33
tabla_precision<-
rbind(accuracy(descuento.train.HW.pred$mean, valid.ts), 
 accuracy(descuento.train.ARIMA.pred$mean, valid.ts),
      accuracy(descuento.train.SARIMA.pred$mean, valid.ts) )
 

row.names(tabla_precision) <- c( "Holt-Winters", "ARIMA(1,2,2)", "SARIMA(3,2,2)[1,0,0]")

knitr::kable(tabla_precision)
ME RMSE MAE MPE MAPE ACF1 Theil’s U
Holt-Winters 0.3963160 0.5338683 0.4075679 5.322271 5.447802 0.7693130 3.818341
ARIMA(1,2,2) -0.4110183 0.4646781 0.4122375 -5.359683 5.372694 0.7356667 3.180377
SARIMA(3,2,2)[1,0,0] 0.4421966 0.7027489 0.4678544 6.051684 6.352739 0.8573577 5.111225