library(tsibble)
library(dplyr)
library(fable)
library(fabletools)
library(vctrs)
library(purrr)
library(distributional)Calculating growth rates from fable forecasts
Intro
This is an attempt to calculate growth rates from fable forecasts of a volume variable. Data was the tourism dataset from tsibble package.
Libraries loaded
Libs needed for this:
Base fit and forecast
tsb_selected <- tourism |>
filter(Region %in% c('Adelaide') ) |>
filter(Purpose %in% c('Business', 'Holiday') )
fit_selected <- tsb_selected |>
model( ets = ETS(log(Trips) ) )
fc_ahead <- fit_selected |>
forecast(h = 5)
fc_ahead |>
group_by_key() |>
slice_tail(n=3) |>
knitr::kable()| Region | State | Purpose | .model | Quarter | Trips | .mean |
|---|---|---|---|---|---|---|
| Adelaide | South Australia | Business | ets | 2018 Q3 | t(N(5.2, 0.057)) | 191.2471 |
| Adelaide | South Australia | Business | ets | 2018 Q4 | t(N(5.1, 0.055)) | 169.5137 |
| Adelaide | South Australia | Business | ets | 2019 Q1 | t(N(5, 0.053)) | 147.8054 |
| Adelaide | South Australia | Holiday | ets | 2018 Q3 | t(N(5.1, 0.021)) | 166.4275 |
| Adelaide | South Australia | Holiday | ets | 2018 Q4 | t(N(5.2, 0.021)) | 186.0615 |
| Adelaide | South Australia | Holiday | ets | 2019 Q1 | t(N(5.3, 0.022)) | 212.8007 |
Getting a fable from historic data using augment() on the model fit
- Using
augment()on the mable holding the model fit to get the proper key grid. - Mutate observation values into lognormal distributions with zero variance.
- Fixing the class of the tsibble using
as_fable()anddimnames().
fable_from_augmented_fit <- fit_selected |>
augment() |>
select(-any_of(c(".innov", ".fitted", ".resid"))) |>
mutate(Trips = dist_lognormal( log(Trips), 0)) |>
mutate(.mean = mean(Trips))
dimnames(fable_from_augmented_fit$Trips) <- "Trips"
fable_from_augmented_fit <- fable_from_augmented_fit |>
as_fable(response = "Trips", distribution = "Trips")
fable_from_augmented_fit |>
group_by_key() |>
slice_tail(n=3) |>
knitr::kable()| Region | State | Purpose | .model | Quarter | Trips | .mean |
|---|---|---|---|---|---|---|
| Adelaide | South Australia | Business | ets | 2017 Q2 | lN(5.2, 0) | 173.7364 |
| Adelaide | South Australia | Business | ets | 2017 Q3 | lN(5.2, 0) | 185.3026 |
| Adelaide | South Australia | Business | ets | 2017 Q4 | lN(5.3, 0) | 197.2800 |
| Adelaide | South Australia | Holiday | ets | 2017 Q2 | lN(5.3, 0) | 201.7341 |
| Adelaide | South Australia | Holiday | ets | 2017 Q3 | lN(5.1, 0) | 163.7119 |
| Adelaide | South Australia | Holiday | ets | 2017 Q4 | lN(5.4, 0) | 214.0531 |
Modify the values in the forecast to be dist_lognormal too
- Get vector data and extract the first elements from dist_transformed.
- It is a list of dist_normal objects.
- Restore the data structure.
- Turn dist_normal into dist_lognormal using
exp(). - Calculate .mean with the proper
mean()method. - Bind both fables.
y_as_lnorm <- fc_ahead |>
pull(Trips) |>
vec_data() |>
lapply (\(x) x[[1]] ) |>
vec_restore( fc_ahead$Trips ) |>
exp()
fc_as_lnorm <- fc_ahead |>
mutate( Trips = y_as_lnorm ) |>
mutate( .mean = mean(Trips) )
fc_all <- dplyr::bind_rows(fable_from_augmented_fit, fc_as_lnorm)Plot of the fable containing zero-variance past observations and future forecasts.
autoplot(fc_all, level=90)
Calculate 4-period growth ratios
- Extract a vector of lagged distributions, inside the proper groups, and replacing first elements with an empty-valued lognormal distribution.
- Mutate the distribution column into growth ratios. This is calculated as the logarithmic differences of not lagged vs lagged distributions. The difference is turned with the exponential function into a growth ratio that has a lognormal distribution.
- The mean is recalculated.
Trips_lagged <- fc_all |>
group_by_key() |>
mutate ( dplyr::lag(Trips, n = 4, default = dist_lognormal(NA,NA)), .keep = "none") |>
pull()
fc_diff <- fc_all |>
mutate(Trips = exp( log(Trips) - log(Trips_lagged) )) |>
mutate(.mean = mean(Trips))Plot the growth ratios
autoplot(fc_diff, level=90)Warning: Removed 8 rows containing missing values or values outside the scale range
(`geom_line()`).
fc_diff |>
tsibble::group_by_key() |>
slice_tail(n=7) |>
knitr::kable()| Region | State | Purpose | .model | Quarter | Trips | .mean |
|---|---|---|---|---|---|---|
| Adelaide | South Australia | Business | ets | 2017 Q3 | lN(-0.056, 0) | 0.9455021 |
| Adelaide | South Australia | Business | ets | 2017 Q4 | lN(0.26, 0) | 1.2942429 |
| Adelaide | South Australia | Business | ets | 2018 Q1 | lN(0.11, 0.05) | 1.1443523 |
| Adelaide | South Australia | Business | ets | 2018 Q2 | lN(-0.016, 0.054) | 1.0110223 |
| Adelaide | South Australia | Business | ets | 2018 Q3 | lN(0.0035, 0.057) | 1.0324899 |
| Adelaide | South Australia | Business | ets | 2018 Q4 | lN(-0.18, 0.055) | 0.8595744 |
| Adelaide | South Australia | Business | ets | 2019 Q1 | lN(0, 0.1) | 1.0529582 |
| Adelaide | South Australia | Holiday | ets | 2017 Q3 | lN(0.06, 0) | 1.0622578 |
| Adelaide | South Australia | Holiday | ets | 2017 Q4 | lN(0.38, 0) | 1.4551339 |
| Adelaide | South Australia | Holiday | ets | 2018 Q1 | lN(-0.026, 0.019) | 0.9843241 |
| Adelaide | South Australia | Holiday | ets | 2018 Q2 | lN(-0.18, 0.02) | 0.8402325 |
| Adelaide | South Australia | Holiday | ets | 2018 Q3 | lN(0.0062, 0.021) | 1.0166418 |
| Adelaide | South Australia | Holiday | ets | 2018 Q4 | lN(-0.15, 0.021) | 0.8692798 |
| Adelaide | South Australia | Holiday | ets | 2019 Q1 | lN(0, 0.041) | 1.0208891 |