5.11.1 - Produce forecasts for the following series using whichever of NAIVE(y), SNAIVE(y) or RW(y ~ drift()) is more appropriate in each case:

Australian Population (global_economy)

library(tidyverse) 
## Warning: package 'ggplot2' was built under R version 4.3.2
## Warning: package 'tidyr' was built under R version 4.3.2
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(fpp3)
## Warning: package 'fpp3' was built under R version 4.3.3
## Registered S3 method overwritten by 'tsibble':
##   method               from 
##   as_tibble.grouped_df dplyr
## ── Attaching packages ──────────────────────────────────────────── fpp3 1.0.1 ──
## ✔ tsibble     1.1.5     ✔ feasts      0.4.1
## ✔ tsibbledata 0.4.1     ✔ fable       0.4.1
## Warning: package 'tsibble' was built under R version 4.3.3
## 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.3
## ── 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(plotly)
## 
## Attaching package: 'plotly'
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following object is masked from 'package:graphics':
## 
##     layout
ausie_pop <- global_economy |>
  filter(Country == 'Australia') |>
  select(Population)

ausie_pop |>
  model(NAIVE(Population), Drift = RW(Population ~ drift())) |>
  forecast(h=15) |>
  autoplot(ausie_pop, level= NULL)

Bricks (aus_production)

bricks <- aus_production |> 
  select(Quarter,Bricks) |> 
  filter(!is.na(Bricks))

bricks %>% 
  model(NAIVE(Bricks)) |> 
  forecast(h=10) |> 
  autoplot(bricks)

NSW Lambs (aus_livestock)

nsw_lambs <- aus_livestock |>
  filter(Animal=='Lambs') |>
  select(Count, State)

nsw_lambs |> 
  model(SNAIVE(Count), NAIVE(Count), Drift = RW(Count ~ drift())) |>
  forecast(h=15) |> 
  autoplot(nsw_lambs)

nsw_lambs <- aus_livestock |>
  filter(Animal=='Lambs', State == 'South Australia') |>
  select(Count, State)

nsw_lambs |> 
  model(SNAIVE(Count)) |>
  forecast(h=15) |> 
  autoplot(nsw_lambs, level= NULL)

household wealth

aus_hh_wealth <- hh_budget |> 
     select(Country, Year, Wealth)

fit_household <- aus_hh_wealth |>
     model(`Naïve` = NAIVE(Wealth),Drift = RW(Wealth ~ drift()))

household_forcast <- fit_household |> 
     forecast(h = 10)

household_forcast |> 
     autoplot(aus_hh_wealth, level = NULL) + 
     guides(color = guide_legend(title = "Forecast"))

Australian takeaway food turnover (aus_retail).

aus_tak_food_to <- aus_retail|>
  filter(Industry=='Takeaway food services') |>
  select(Turnover)

aus_take_mod <- aus_tak_food_to |>
  model(SNAIVE(Turnover)) |> 
  forecast(h=10)
  autoplot(aus_tak_food_to) + labs(title = "Australian Takeaway Food Turnover") +
  facet_wrap(~State, scales = "free")+ theme(axis.text.x = element_text(angle = 90, vjust = 1, hjust=3))  
## Plot variable not specified, automatically selected `.vars = Turnover`

5.11.2 - Use the Facebook stock price (data set gafa_stock) to do the following:

fb_stock <- gafa_stock |>
  filter(Symbol == "FB") |>
  mutate(day = row_number()) |>
  update_tsibble(index = day, regular = TRUE)

fb_stock |>
  autoplot(Close) + labs(title= "Facebook stock price ")

fb_stock |>
  model(RW(Close ~ drift())) |>
  forecast(h = 60) |>
  autoplot(fb_stock) + labs(title = "Facebook stock price Drift method")

fb_stock |>
  model(RW(Close ~ drift())) |>
  forecast(h = 60) |>
  autoplot(fb_stock) +labs(title = "Facebook stock identical forcast") +
  geom_segment(aes(x = 1, y = 54.83, xend = 1258, yend = 134.45),
               color = "red", linetype = "dashed")
## Warning in geom_segment(aes(x = 1, y = 54.83, xend = 1258, yend = 134.45), : All aesthetics have length 1, but the data has 1258 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.

fb_stock %>%
  model(Mean = MEAN(Close),
        `Naïve` = NAIVE(Close),
        Drift = NAIVE(Close ~ drift())) %>%
  forecast(h = 60) %>%
  autoplot(fb_stock, level = NULL) +
  labs(title = "Facebook stock with multiple benchmarks")

5.11.3 Apply a seasonal naïve method to the quarterly Australian beer production data from 1992. Check if the residuals look like white noise, and plot the forecasts. The following code will help.

# Extract data of interest
aus_beer_prod <- aus_production |>
     filter(year(Quarter) >= 1992)

aus_beer_prod |> autoplot(Beer)

decomp <- aus_beer_prod |> model(stl = STL(Beer))

components(decomp) |> autoplot()

# Define and estimate a model
fit <- aus_beer_prod |> model(SNAIVE(Beer))

# Look at the residuals
fit |> gg_tsresiduals()
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 4 rows containing non-finite outside the scale range
## (`stat_bin()`).

# Look a some forecasts
fit |> forecast() |> autoplot(aus_beer_prod)

The ACF plot shows a strong autocorrelation at lag 4, suggesting a repeating pattern in the data.

5.11.4 Repeat the previous exercise using the Australian Exports series from global_economy and the Bricks series from aus_production. Use whichever of NAIVE() or SNAIVE() is more appropriate in each case.

# Australian exports
aus_exprt <- global_economy |> 
     select(Country, Year, Exports) |> 
     filter(Country == 'Australia')

aus_exprt |> 
     autoplot() + labs(title = "Australian Exports")
## Plot variable not specified, automatically selected `.vars = Exports`

fit_aus_exprt <- aus_exprt |> 
     model(NAIVE(Exports))

fit_aus_exprt |>
     forecast() |> 
     autoplot(aus_exprt)

# Australian bricks production
bricks |>
     autoplot() + labs(title = "Australian Brick Production")
## Plot variable not specified, automatically selected `.vars = Bricks`

fit_brick <- bricks |> 
     model(SNAIVE(Bricks))

fit_brick |> 
     forecast() |> 
     autoplot(bricks)

5.11.7 – For your retail time series (from Exercise 7 in Section 2.10):

# Create a training dataset consiseting of observations before 2011 using

set.seed(9171973)
myseries <- aus_retail |>
  filter(`Series ID` == sample(aus_retail$`Series ID`,1))
         
myseries_train <- myseries |>
  filter(year(Month) < 2011)

# Check that your data have been split appropriately by producing the following plot.

autoplot(myseries, Turnover) +
  autolayer(myseries_train, Turnover, colour = "blue")

aus_retail
## # A tsibble: 64,532 x 5 [1M]
## # Key:       State, Industry [152]
##    State                        Industry           `Series ID`    Month Turnover
##    <chr>                        <chr>              <chr>          <mth>    <dbl>
##  1 Australian Capital Territory Cafes, restaurant… A3349849A   1982 Apr      4.4
##  2 Australian Capital Territory Cafes, restaurant… A3349849A   1982 May      3.4
##  3 Australian Capital Territory Cafes, restaurant… A3349849A   1982 Jun      3.6
##  4 Australian Capital Territory Cafes, restaurant… A3349849A   1982 Jul      4  
##  5 Australian Capital Territory Cafes, restaurant… A3349849A   1982 Aug      3.6
##  6 Australian Capital Territory Cafes, restaurant… A3349849A   1982 Sep      4.2
##  7 Australian Capital Territory Cafes, restaurant… A3349849A   1982 Oct      4.8
##  8 Australian Capital Territory Cafes, restaurant… A3349849A   1982 Nov      5.4
##  9 Australian Capital Territory Cafes, restaurant… A3349849A   1982 Dec      6.9
## 10 Australian Capital Territory Cafes, restaurant… A3349849A   1983 Jan      3.8
## # ℹ 64,522 more rows
# Fit a seasonal naïve model using SNAIVE() applied to your training data (myseries_train).

fit <- myseries_train |>
  model(SNAIVE(Turnover))

# Check the residuals.

fit |> gg_tsresiduals()
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 12 rows containing non-finite outside the scale range
## (`stat_bin()`).

# Produce forecasts for the test data

fc <- fit |>
  forecast(new_data = anti_join(myseries, myseries_train))
## Joining with `by = join_by(State, Industry, `Series ID`, Month, Turnover)`
fc |> autoplot(myseries, level = NULL)

## Compare the accuracy of your forecasts against the actual values.

fit |> accuracy()
## # A tibble: 1 × 12
##   State    Industry .model .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE  ACF1
##   <chr>    <chr>    <chr>  <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Austral… Other r… SNAIV… Trai… 0.213 0.906 0.705  3.66  10.6     1     1 0.699
fc |> accuracy(myseries)
## # A tibble: 1 × 12
##   .model    State Industry .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE  ACF1
##   <chr>     <chr> <chr>    <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 SNAIVE(T… Aust… Other r… Test   5.53  7.18  5.54  34.3  34.4  7.86  7.92 0.925