bacon
Ryan
2022-11-05
library(readxl)
library(fpp3)## ── Attaching packages ──────────────────────────────────────────── fpp3 0.4.0 ──## ✔ tibble 3.1.8 ✔ tsibble 1.1.2
## ✔ dplyr 1.0.9 ✔ tsibbledata 0.4.1
## ✔ tidyr 1.2.0 ✔ feasts 0.2.2
## ✔ lubridate 1.8.0 ✔ fable 0.3.1
## ✔ ggplot2 3.3.6## ── 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()library(moments)
library(tsibble)
library(tsibbledata)
library(ggplot2)
library(dplyr)
library(seasonal)##
## Attaching package: 'seasonal'## The following object is masked from 'package:tibble':
##
## viewlibrary(fabletools)
library(fable)
library(ggfortify)
library(quantmod)## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following object is masked from 'package:tsibble':
##
## index## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric##
## Attaching package: 'xts'## The following objects are masked from 'package:dplyr':
##
## first, last## Loading required package: TTR## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(GGally)## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2bacon_data <- readxl::read_excel("C:/Users/ryanf/Downloads/Baconator.xls")
bacon <- bacon_data %>%
mutate(Date = yearmonth(Date)) %>%
as_tsibble(index = Date)
bacon %>%
ggplot(aes(x = Date, y = Price)) +
geom_line(aes(y = Price)) +
geom_smooth(method = "lm", se = FALSE) +
labs(y = "Price")## `geom_smooth()` using formula 'y ~ x'
bacon_stl <- bacon %>%
model(STL(Price,)) %>%
components() %>%
autoplot() +
labs(title = "STL Decomp")
bacon_stl
I cleaned up the data and plotted it. After that I ran some decompositions to get an idea of the trend and seasonality that might be present. Based off the decomposition, I noticed some slight seasonality, and a definite trend.
bacon_expo <- bacon %>%
model(ETS(Price ~ error("A") + trend("N") + season("N")))
bacon_expo %>%
forecast(h = 4)%>%
autoplot(bacon) +
geom_line(aes(y = .fitted),
data = augment(bacon_expo)) +
labs(title = "Four Month Forecast of Bacon Prices Expo") 
bacon %>%
model(
`Holt's method` = ETS(Price ~ error("A") + trend("A") + season("N"))) %>%
forecast(h = 4) %>%
autoplot(bacon) +
labs(title = "Four Month Forecast of Bacon Prices Holt")
I did two forecasts using both simple exponential smoothing and also Holt’s model. Holts model expands on the simple model because it works better to fit the trend in the data.
bacon %>%
model(
additive = ETS(Price ~ error("A") + trend("A") + season("A"))) %>%
forecast(h = 4) %>%
autoplot(bacon) +
labs(title = "Four Month Forecast of Bacon Add") 
bacon %>%
model(
multiplicative = ETS(Price ~ error("M") + trend("A") + season("M"))) %>%
forecast(h = 4) %>%
autoplot(bacon) +
labs(title = "Four Month Forecast of Bacon Mult")
I then tried both the additive and multiplicative methods. The main advantage of these models is that they add a seasonal component. Additive is good for constant variance seasonality and multiplicative is good for non-constant variance seasonality. Based off my STL decom, I think there is a seasonal component that is non constant.
bacon %>%
stretch_tsibble(.init = 10) %>%
model(
Simple = ETS(Price ~ error("A") + trend("N") + season("N")),
Holt = ETS(Price ~ error("A") + trend("A") + season("N")),
multiplicative = ETS(Price ~ error("M") + trend("A") + season("M")),
additive = ETS(Price ~ error("A") + trend("A") + season("A"))
) %>%
forecast(h = 1) %>%
accuracy(bacon)## 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: 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: The future dataset is incomplete, incomplete out-of-sample data will be treated as missing.
## 1 observation is missing at 2022 Oct## # A tibble: 4 × 10
## .model .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 additive Test 0.00148 0.135 0.0997 -0.0440 2.16 0.289 0.272 0.320
## 2 Holt Test 0.00176 0.128 0.0949 -0.0315 2.06 0.275 0.259 0.255
## 3 multiplicative Test -0.00120 0.142 0.107 -0.118 2.33 0.311 0.286 0.376
## 4 Simple Test 0.0166 0.128 0.0941 0.304 2.02 0.273 0.258 0.248I did a cross validation of all of the methods that I tried to check the accuracy of the models. Based off the results, the models are pretty much opposite of what I expected in accuracy. The simple exponential smoothing model had the best scores, and the holt model was only slightly worse. The additive and multiplicative scores were a good bit worse though.
bacon_fc <- bacon %>%
model(ETS(Price ~ error("A") + trend("N") + season("N"))) %>%
forecast(h=4)%>%
hilo()
bacon_fc## # A tsibble: 4 x 6 [1M]
## # Key: .model [1]
## .model Date Price .mean `80%`
## <chr> <mth> <dist> <dbl> <hilo>
## 1 "ETS(Price ~ error(\"A\")… 2022 Oct N(7.4, 0.016) 7.38 [7.220737, 7.545261]80
## 2 "ETS(Price ~ error(\"A\")… 2022 Nov N(7.4, 0.032) 7.38 [7.153538, 7.612460]80
## 3 "ETS(Price ~ error(\"A\")… 2022 Dec N(7.4, 0.048) 7.38 [7.101972, 7.664026]80
## 4 "ETS(Price ~ error(\"A\")… 2023 Jan N(7.4, 0.064) 7.38 [7.058500, 7.707498]80
## # … with 1 more variable: `95%` <hilo>My point forecast has a value of $7.38 for the exponential smoothing model, For some reason my prediciton intervals would not show up and only show the “S3 hilo”.