Time Series Forecasting with ARIMA and ETS Models

Base Chunks

Libraries

require(fredr)

## Loading required package: fredr

## Warning: package 'fredr' was built under R version 4.3.2

require(fpp3)

## Loading required package: fpp3

## Warning: package 'fpp3' was built under R version 4.3.2

## ── Attaching packages ────────────────────────────────────────────── fpp3 0.5 ──

## ✔ tibble      3.2.1     ✔ tsibble     1.1.4
## ✔ dplyr       1.1.4     ✔ tsibbledata 0.4.1
## ✔ tidyr       1.3.0     ✔ feasts      0.3.2
## ✔ lubridate   1.9.3     ✔ fable       0.3.3
## ✔ ggplot2     3.5.1     ✔ fabletools  0.4.2

## Warning: package 'tibble' was built under R version 4.3.2

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

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

## Warning: package 'lubridate' was built under R version 4.3.2

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

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

## Warning: package 'tsibbledata' was built under R version 4.3.2

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

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

## Warning: package 'fable' was built under R version 4.3.2

## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date()    masks base::date()
## ✖ dplyr::filter()      masks stats::filter()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval()  masks lubridate::interval()
## ✖ dplyr::lag()         masks stats::lag()
## ✖ tsibble::setdiff()   masks base::setdiff()
## ✖ tsibble::union()     masks base::union()

require(ggplot2)

API Key (Hidden)

Load Data

mydata=fredr(
  series_id = "JTU540099HIL"
)
mydata=mydata[,c(1,3)]
mydata=mydata %>% mutate(date = yearmonth(date))

Convert to tsibble

ts=as_tsibble(mydata, index = date)
train=as_tsibble(ts[1:229,], index=date)
test=as_tsibble(ts[230:nrow(ts),], index=date)

Build Models

m1=train %>%model(ARIMA(value))
m2=train %>% model(ETS(value))

Plots

autoplot(ts)

## Plot variable not specified, automatically selected `.vars = value`

ts%>%ACF(value)%>%autoplot()

ts%>%PACF(value)%>%autoplot()

Forecast

f1=m1 %>% forecast(test)
f2=m2 %>%  forecast(test)

Accuracy on Test Set

a1=accuracy(f1, test)
a2=accuracy(f2, test)
rbind(a1, a2)

## # A tibble: 2 × 10
##   .model       .type    ME  RMSE   MAE     MPE  MAPE  MASE RMSSE  ACF1
##   <chr>        <chr> <dbl> <dbl> <dbl>   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ARIMA(value) Test   51.8  132.  96.5  3.45    8.02   NaN   NaN 0.642
## 2 ETS(value)   Test   12.3  125.  94.9 -0.0448  8.18   NaN   NaN 0.653

Report

print(report(m1))

## Series: value 
## Model: ARIMA(2,0,1)(1,1,1)[12] 
## 
## Coefficients:
##          ar1      ar2      ma1    sar1     sma1
##       1.0197  -0.0417  -0.6129  0.0826  -0.8662
## s.e.  0.1178   0.1107   0.0932  0.0878   0.0682
## 
## sigma^2 estimated as 4545:  log likelihood=-1226.49
## AIC=2464.99   AICc=2465.39   BIC=2485.27
## # A mable: 1 x 1
##              `ARIMA(value)`
##                     <model>
## 1 <ARIMA(2,0,1)(1,1,1)[12]>

print(report(m2))

## Series: value 
## Model: ETS(A,A,A) 
##   Smoothing parameters:
##     alpha = 0.3998467 
##     beta  = 0.0001002517 
##     gamma = 0.0001034006 
## 
##   Initial states:
##      l[0]      b[0]      s[0]    s[-1]     s[-2]    s[-3]    s[-4]    s[-5]
##  988.6894 0.5604929 -114.8717 71.66683 -28.29604 25.71499 74.49123 76.04344
##     s[-6]    s[-7]     s[-8]     s[-9]   s[-10]    s[-11]
##  48.63812 130.7555 -53.23764 -119.3122 79.34309 -190.9356
## 
##   sigma^2:  4286.229
## 
##      AIC     AICc      BIC 
## 3176.900 3179.801 3235.273 
## # A mable: 1 x 1
##   `ETS(value)`
##        <model>
## 1 <ETS(A,A,A)>

Plot

# Plot the forecasts
f1df <- as.data.frame(f1)
f2df <- as.data.frame(f2)
tsdf <- as.data.frame(ts)

# Plot using ggplot2
ggplot(tsdf, aes(x = date, y = value)) +
  geom_line(color = "black", linewidth = .5) +
  geom_line(data = f1df, aes(x = date, y = .mean, color = "ARIMA Forecast"), linetype = "dashed") +
  geom_line(data = f2df, aes(x = date, y = .mean, color = "ETS Forecast"), linetype = "dotted") +
  ggtitle("Forecast Comparison") +
  xlab("Year") +
  ylab("Value") +
  scale_color_manual(name = "Forecast",
                     values = c("ARIMA Forecast" = "blue", "ETS Forecast" = "red")) +
  theme_minimal() +
  theme(legend.position = "bottom")