Load packages and data

library(fpp3)
library(readxl)

Questions

Exercise 1

Bacon_Price <- read_excel("C:\\Users\\Zacha\\Downloads\\Bacon Price.xlsx")

bacon <- Bacon_Price %>%
  mutate(Date = yearmonth(Date)) %>%
  as_tsibble(index = Date)
autoplot(bacon)
## Plot variable not specified, automatically selected `.vars = Cost`

trainbacon <- bacon %>%
  filter(year(Date) < 2016)

testbacon <- bacon %>%
  filter(year(Date) > 2015)


bacon_stl <- bacon %>%
  model(classical_decomposition(Cost, type = "multiplicative")) %>%
  components() %>%
  autoplot() +
  labs(title = "Classical Multiplicative Decomposition of Bacon Price")
bacon_stl
## Warning: Removed 6 row(s) containing missing values (geom_path).

#I see a nice upward trend, but no clear signs of seasonality or cycle.

Exercise 2

#Simple Exponential Smoothing
fitbacon <- bacon %>%
  model(ETS(Cost ~ error("A") + trend("N") + season("N")))

bacon %>% autoplot(Cost)+
  geom_line(aes(y =.fitted), col="#D55E00", data = augment(fitbacon))

fitbacon %>%
  forecast(h = 4)%>%
  autoplot(bacon) +
  geom_line(aes(y = .fitted), col="#D55E00",
            data = augment(fitbacon)) +
  labs(y="Cost", title="4 Month SES Bacon Forecast") +
  guides(colour = "none")

#Holt's Method 
fitbacon2 <- bacon %>%
  model(ETS(Cost ~ error("A") + trend("A") + season("N")))

bacon %>% autoplot(Cost)+
  geom_line(aes(y =.fitted), col="#D55E00", data = augment(fitbacon2))

fitbacon2 %>%
  forecast(h = 4)%>%
  autoplot(bacon) +
  geom_line(aes(y = .fitted), col="#D55E00",
            data = augment(fitbacon2)) +
  labs(y="Cost", title="4 Month Holt Bacon Forecast") +
  guides(colour = "none")

#Damped Holt's Method

fitbacon3 <- bacon %>%
  model(ETS(Cost ~ error("A") + trend("Ad", phi = 0.9) + season("N")))

bacon %>% autoplot(Cost)+
  geom_line(aes(y =.fitted), col="#D55E00", data = augment(fitbacon3))

fitbacon3 %>%
  forecast(h = 4)%>%
  autoplot(bacon) +
  geom_line(aes(y = .fitted), col="#D55E00",
            data = augment(fitbacon3)) +
  labs(y="Cost", title="4 Month Damped Holt Bacon Forecast") +
  guides(colour = "none")

Exercise 3

#Holt-Winters Additive and Multiplicative Method

pieceoffit <- bacon %>%
  model(
    Additive = ETS(Cost ~ error("A") + trend("A") + season("A")),
    Multiplicative = ETS(Cost ~ error("M") + trend("A") + season("M"))
  )

forecastbc <- pieceoffit %>% forecast()

forecastbc %>%
  autoplot(bacon, level = NULL) + 
  labs(y = "Cost", title = "Holts-Winters Additive and Multiplicative")

### Exercise 4

#Holt-Winters Damped Method

bacon %>%
  model(hw = ETS(Cost ~ error("M") + trend("Ad") + season("M"))) %>%
  forecast(h = 4) %>%
  autoplot(bacon) +
  labs(title = "Holt-Winters damped method",
       y="Cost")

Exercise 5

kevinbacon <- trainbacon %>%
  stretch_tsibble(.init = 10) %>%
  model(
    Additive = ETS(Cost ~ error("A") + trend("A") + season("A")),
    Multiplicative = ETS(Cost ~ error("M") + trend("A") + season("M")),
    SES = ETS(Cost ~ error("A") + trend("N") + season("N")),
    Holt = ETS(Cost ~ error("A") + trend("A") + season("N")),
    Damped = ETS(Cost ~ error("M") + trend("Ad") +
                   season("M"))
  ) %>%
  forecast(h = 1)
## Warning: 8 errors (2 unique) encountered for Additive
## [3] A seasonal ETS model cannot be used for this data.
## [5] Not enough data to estimate this ETS model.
## Warning: 8 errors (2 unique) encountered for Multiplicative
## [3] A seasonal ETS model cannot be used for this data.
## [5] Not enough data to estimate this ETS model.
## Warning: 9 errors (2 unique) encountered for Damped
## [3] A seasonal ETS model cannot be used for this data.
## [6] Not enough data to estimate this ETS model.
accuracy(kevinbacon, testbacon, list(rmse = RMSE, mae = MAE, mape = MAPE))
## Warning: The future dataset is incomplete, incomplete out-of-sample data will be treated as missing. 
## 182 observations are missing between 2000 Nov and 2015 Dec
## # A tibble: 5 x 5
##   .model         .type   rmse    mae  mape
##   <chr>          <chr>  <dbl>  <dbl> <dbl>
## 1 Additive       Test  0.110  0.110   1.94
## 2 Damped         Test  0.109  0.109   1.93
## 3 Holt           Test  0.106  0.106   1.87
## 4 Multiplicative Test  0.125  0.125   2.22
## 5 SES            Test  0.0780 0.0780  1.38
#The Simple exponential smoothing method by far yielded the lowest RMSE and the lowest MAE so it is the clear winner. 
#I think it's important to also test the accuracy for a forecast of 4 months because that is what we're forecasting after all. 

kevinbacon2 <- trainbacon %>%
  stretch_tsibble(.init = 10) %>%
  model(
    Additive = ETS(Cost ~ error("A") + trend("A") + season("A")),
    Multiplicative = ETS(Cost ~ error("M") + trend("A") + season("M")),
    SES = ETS(Cost ~ error("A") + trend("N") + season("N")),
    Holt = ETS(Cost ~ error("A") + trend("A") + season("N")),
    Damped = ETS(Cost ~ error("M") + trend("Ad") +
                   season("M"))
  ) %>%
  forecast(h = 4)
## Warning: 8 errors (2 unique) encountered for Additive
## [3] A seasonal ETS model cannot be used for this data.
## [5] Not enough data to estimate this ETS model.
## Warning: 8 errors (2 unique) encountered for Multiplicative
## [3] A seasonal ETS model cannot be used for this data.
## [5] Not enough data to estimate this ETS model.
## Warning: 9 errors (2 unique) encountered for Damped
## [3] A seasonal ETS model cannot be used for this data.
## [6] Not enough data to estimate this ETS model.
accuracy(kevinbacon2, testbacon, list(rmse = RMSE, mae = MAE, mape = MAPE))
## Warning: The future dataset is incomplete, incomplete out-of-sample data will be treated as missing. 
## 182 observations are missing between 2000 Nov and 2015 Dec
## # A tibble: 5 x 5
##   .model         .type  rmse   mae  mape
##   <chr>          <chr> <dbl> <dbl> <dbl>
## 1 Additive       Test  0.299 0.257  4.69
## 2 Damped         Test  0.311 0.275  5.01
## 3 Holt           Test  0.349 0.317  5.77
## 4 Multiplicative Test  0.261 0.227  4.14
## 5 SES            Test  0.297 0.260  4.74
#This is interesting. When the forecast was 1 month the SES had the lowest rmse and mae, but when the forecast is changed to 4 now it's the Multiplicative method!

The Forecast

multi.bacon <- bacon %>%
  model(Multiplicative = ETS(Cost ~ error("M") + trend("A") + season("M")))

multi.bacon %>% 
  forecast(h = 4) %>%
  autoplot(bacon) +
  geom_line(aes(y = .fitted), color = "orange", data = augment(multi.bacon)) +
  labs(y = "Bacon Price") +
  guides(color = "none")

multi.bacon %>%
  forecast(h = 4) %>%
  hilo()
## # A tsibble: 4 x 6 [1M]
## # Key:       .model [1]
##   .model             Date          Cost .mean                  `80%`
##   <chr>             <mth>        <dist> <dbl>                 <hilo>
## 1 Multiplicative 2022 Oct N(7.3, 0.036)  7.34 [7.097398, 7.584216]80
## 2 Multiplicative 2022 Nov N(7.2, 0.064)  7.17 [6.840345, 7.490803]80
## 3 Multiplicative 2022 Dec N(7.1, 0.093)  7.10 [6.709517, 7.489646]80
## 4 Multiplicative 2023 Jan  N(7.1, 0.12)  7.10 [6.648480, 7.543256]80
## # ... with 1 more variable: `95%` <hilo>
## # i Use `colnames()` to see all variable names

The Holt-Winter Multiplicative method proved to be the most accurate option. It yielded the lowest rmse and mae values when the accuracy was tested for a 4 month forecast. It is actually forecasting a decrease in price per pound of bacon for the next 4 months which is interesting given the clear upward trend of the data. The data has an element of randomness and ups and downs that makes this completely feasible however.