2026-02-22library(fpp3)
## Warning: package 'fpp3' was built under R version 4.4.3
## Warning: replacing previous import 'feasts::scale_x_cf_lag' by
## 'ggtime::scale_x_cf_lag' when loading 'fpp3'
## Warning: replacing previous import 'feasts::gg_season' by 'ggtime::gg_season'
## when loading 'fpp3'
## Warning: replacing previous import 'feasts::gg_tsresiduals' by
## 'ggtime::gg_tsresiduals' when loading 'fpp3'
## Warning: replacing previous import 'feasts::gg_irf' by 'ggtime::gg_irf' when
## loading 'fpp3'
## Warning: replacing previous import 'feasts::gg_arma' by 'ggtime::gg_arma' when
## loading 'fpp3'
## Warning: replacing previous import 'feasts::gg_tsdisplay' by
## 'ggtime::gg_tsdisplay' when loading 'fpp3'
## Warning: replacing previous import 'feasts::gg_subseries' by
## 'ggtime::gg_subseries' when loading 'fpp3'
## Warning: replacing previous import 'feasts::gg_lag' by 'ggtime::gg_lag' when
## loading 'fpp3'
## Warning: package 'dplyr' was built under R version 4.4.3
## Warning: package 'ggplot2' was built under R version 4.4.3
## Warning: package 'tsibble' was built under R version 4.4.3
## Warning: package 'tsibbledata' was built under R version 4.4.3
## Warning: package 'ggtime' was built under R version 4.4.3
## Warning: package 'feasts' was built under R version 4.4.3
## Warning: package 'fabletools' was built under R version 4.4.3
## Warning: package 'fable' was built under R version 4.4.3
library(forecast)
## Warning: package 'forecast' was built under R version 4.4.3
library(dplyr)
library(ggplot2)
#Australian Population:Appropriate Model: Random Walk with drift becasue population has strong upward, no seasonality,Growth roughly linear
library(fpp3)
aus_pop <- global_economy |>
filter(Country == "Australia") |>
select(Year, Population)
fit_pop <- aus_pop |>
model(RW(Population ~ drift()))
forecast(fit_pop)
aussie_drift <- global_economy %>%
filter(Country == "Australia") %>%
model(RW(Population ~ drift())) %>%
forecast(h = "10 years")
aussie_drift %>%
autoplot(global_economy) +
labs(title = "10 Year Drift Forecast for Population of Australia",
x = "Year",
y = "Population") +
scale_y_continuous(labels = scales::comma_format()) +
theme_minimal()
#Bricks (aus_production):Appropriate Model:SNAIVE() Bricks: Strong quarterly seasonality because Cyclical behavior,No clear stable trend. So seasonal naive is best.
bricks <- aus_production |>
select(Quarter, Bricks)
fit_bricks <- bricks |>
model(SNAIVE(Bricks))
forecast(fit_bricks)
aus_bricks <- aus_production %>%
mutate(Bricks = na.interp(Bricks))
bricks_naive <- aus_bricks %>%
model(NAIVE(Bricks)) %>%
forecast(h = "2 years")
bricks_naive %>%
autoplot(aus_bricks) +
labs(title = "Two Year Naive Forecast for Australian Brick Production",
x = "Quarter & Year",
y = "Bricks Produced") +
scale_y_continuous(labels = scales::comma_format()) +
theme_minimal()
#NSW Lambs:Livestock slaughter:Appropriate Model: SNAIVE() Because Strong seasonal pattern:No strong deterministic trend.
lambs <- aus_livestock |>
filter(State == "New South Wales",
Animal == "Lambs")
fit_lambs <- lambs |>
model(SNAIVE(Count))
forecast(fit_lambs)
lambs_snaive <- aus_livestock %>%
filter(Animal == "Lambs", State == "New South Wales") %>%
model(SNAIVE(Count)) %>%
forecast(h = "4 years")
lambs_snaive %>%
autoplot(aus_livestock) +
labs(title = "Four Year Seasonal Naive Forecast for Australian Lamb Production",
x = "Year",
y = "Lambs") +
scale_y_continuous(labels = scales::comma_format()) +
theme_minimal()
#Household Wealth (hh_budget) :Appropriate Model:Random walk with drift fits best Because Wealth has strong upward trend,no seasonal structure
wealth <- hh_budget |>
select(Year, Wealth)
fit_wealth <- wealth |>
model(RW(Wealth ~ drift()))
forecast(fit_wealth)
wealth_rw <- hh_budget %>%
model(RW(Wealth ~ drift())) %>%
forecast(h = "5 years")
wealth_rw %>%
autoplot(hh_budget) +
labs(title = "Five Year RW Drift Forecast for Household Wealth",
x = "Year",
y = "Wealth") +
scale_y_continuous(labels = scales::dollar_format(scale = 1, prefix = "$", big.mark = ",")) +
theme_minimal()
#Appropriate Model:Seasonal NAIVE():because retail turnover has strong seasonality
library(fpp3)
library(dplyr)
library(stringr)
# Filter (adjust patterns as needed)
takeaway <- aus_retail |>
filter(
str_detect(State, regex("Australia|Total|All", ignore_case = TRUE)),
str_detect(Industry, regex("takeaway|cafes|restaurants", ignore_case = TRUE))
)
cat("Rows after filter:", nrow(takeaway), "\n")
## Rows after filter: 3969
print(takeaway |> distinct(State, Industry))
## # A tibble: 9 × 2
## State Industry
## <chr> <chr>
## 1 Australian Capital Territory Cafes, restaurants and catering services
## 2 Australian Capital Territory Cafes, restaurants and takeaway food services
## 3 Australian Capital Territory Takeaway food services
## 4 South Australia Cafes, restaurants and catering services
## 5 South Australia Cafes, restaurants and takeaway food services
## 6 South Australia Takeaway food services
## 7 Western Australia Cafes, restaurants and catering services
## 8 Western Australia Cafes, restaurants and takeaway food services
## 9 Western Australia Takeaway food services
if (nrow(takeaway) == 0) {
stop("Your filter returned 0 rows. Run: aus_retail |> distinct(State) and distinct(Industry) to see exact labels.")
}
fit_takeaway <- takeaway |>
model(SNAIVE(Turnover))
fc_takeaway <- fit_takeaway |> forecast(h = 24)
fc_takeaway
takeaway_snaive <- aus_retail %>%
filter(Industry == "Takeaway food services") %>%
model(SNAIVE(Turnover)) %>%
forecast(h = "7 years")
takeaway_snaive %>%
autoplot(aus_retail) +
labs(title = "Seven Year Seasonal Naive Forecast for Takeaway Food Turnover",
x = "Year",
y = "Turnover") +
scale_y_continuous(labels = scales::comma_format()) +
theme_minimal()
fb_stock <- gafa_stock %>%
filter(Symbol == "FB") %>%
update_tsibble(index = Date, regular = TRUE) %>%
fill_gaps()
fb_stock %>%
autoplot(Close) +
labs(title = "Facebook Stock Price - 2014-2018",
x = "Year",
y = "Closing Price") +
scale_y_continuous(labels = scales::comma_format()) +
theme_minimal()
#The Facebook stock price shows strong upward growth with noticeable
volatility.
There is no seasonality, but the series behaves like a non-stationary
random walk with trend.
#Forecast using the Drift Method
fb_first_last <- fb_stock %>%
slice(c(1, n()))
fb_drift <- fb_stock %>%
model(Drift = RW(Close ~ drift())) %>%
forecast(h = "2 years")
fb_last_f <- fb_drift %>%
slice(n())
fb_drift %>%
autoplot(fb_stock) +
geom_point(data = fb_first_last, aes(x = Date, y = Close), color = "blue", size = 3) +
annotate("segment",
x = first(fb_first_last$Date), y = first(fb_first_last$Close),
xend = last(fb_first_last$Date), yend = last(fb_first_last$Close),
color = "red", linetype = "dashed", size = 1) +
geom_line(data = fb_drift, aes(x = Date, y = .mean), color = "purple", size = 1) +
geom_point(data = fb_last_f, aes(x = Date, y = .mean), color = "green", size = 3) +
labs(title = "2 Year Forecast of Facebook Stock using RW Drift",
x = "Date",
y = "Price") +
theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
#This code creates and draws the forecast using RW drift Plots as blue
dots the first and last points of the historical data and draws a red
dashed line between them Plots as a green dot the last point in the
forecast, using the mean as the plotted point Plots a solid purple line
from the last historical point to the edge of the graph at the same
slope as the historical line This shows that extending the line is the
same as the forecast since it falls within the predicted range
#Here’s a seasonal naive forecast:
fb_snaive <- fb_stock %>%
model(SNAIVE(Close)) %>%
forecast(h = "7 years")
fb_snaive %>%
autoplot(fb_stock) +
labs(title = "Seven Year Seasonal Naive Forecast for FB Stock",
x = "Year",
y = "Price") +
scale_y_continuous(labels = scales::comma_format()) +
theme_minimal()
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_line()`).
#Here’s a regular naive forecast:
fb_naive <- fb_stock %>%
model(NAIVE(Close)) %>%
forecast(h = "7 years")
fb_naive %>%
autoplot(fb_stock) +
labs(title = "Seven Year Naive Forecast for FB Stock",
x = "Year",
y = "Price") +
scale_y_continuous(labels = scales::comma_format()) +
theme_minimal()
#he SNaive is the most accurate of the two because it includes more room for upward growth
# Extract data from 1992 onward
recent_production <- aus_production |>
filter(year(Quarter) >= 1992)
# Seasonal naïve model
fit <- recent_production |>
model(SNAIVE(Beer))
# Residual diagnostics
fit |> gg_tsresiduals()
## Warning: `gg_tsresiduals()` was deprecated in feasts 0.4.2.
## ℹ Please use `ggtime::gg_tsresiduals()` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## 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()`).
# Forecast plot
fit |> forecast() |>
autoplot(recent_production)
#The seasonal naïve model captures the quarterly seasonal pattern
reasonably well, as seen by the repeating seasonal structure in the
forecasts.
However, the residual diagnostics suggest that the residuals are not completely white noise. There appears to be some remaining autocorrelation and possible structural change in the series.
This indicates that while SNAIVE accounts for seasonality, it does not capture longer-term changes in level or variability. Therefore, although it is a useful benchmark model, a more sophisticated model (such as ETS or ARIMA) may provide improved forecasts. Interpretation in Simple Terms
library(fpp3)
# Extract Australian exports
aus_exports <- global_economy |>
filter(Country == "Australia") |>
select(Year, Exports)
# Fit NAIVE model
fit_exports <- aus_exports |>
model(NAIVE(Exports))
# Residual diagnostics
fit_exports |> gg_tsresiduals()
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_bin()`).
# Forecasts
fit_exports |> forecast(h = 5) |>
autoplot(aus_exports)
#The Australian exports series is annual and shows no seasonal pattern. Therefore, the NAIVE model is appropriate. The residuals indicate some remaining autocorrelation, suggesting the model does not capture longer-term economic trends. The NAIVE method serves as a simple benchmark forecast.
# Extract Bricks series
bricks <- aus_production |>
select(Quarter, Bricks)
# Fit seasonal naive
fit_bricks <- bricks |>
model(SNAIVE(Bricks))
# Residual diagnostics
fit_bricks |> gg_tsresiduals()
## Warning: Removed 24 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 24 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 24 rows containing non-finite outside the scale range
## (`stat_bin()`).
# Forecast
fit_bricks |> forecast(h = 8) |>
autoplot(bricks)
## Warning in max(ids, na.rm = TRUE): no non-missing arguments to max; returning
## -Inf
## Warning in max(ids, na.rm = TRUE): no non-missing arguments to max; returning
## -Inf
## Warning: Removed 8 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 20 rows containing missing values or values outside the scale range
## (`geom_line()`).
#The Bricks series exhibits strong quarterly seasonality. The SNAIVE
model appropriately captures this repeating seasonal pattern by using
last year’s values as forecasts.
However, residual diagnostics suggest that some autocorrelation remains, indicating possible structural changes or longer-term trends. Thus, SNAIVE is an appropriate benchmark but may not fully capture the dynamics of the series.
#A: Create a training dataset consisting of observations before 2011 using provided code:
aus_agg <- aus_retail |>
index_by(Month) |>
summarise(Turnover = sum(Turnover))
myseries_train <- aus_retail |>
filter(year(Month) < 2011)
myseries_train_agg <- myseries_train |>
index_by(Month) |>
summarise(Turnover = sum(Turnover))
#Check that your data have been split appropriately by producing the following plot
autoplot(aus_agg, Turnover) +
autolayer(myseries_train_agg, Turnover) +
labs(title = "Aggregated Retail Turnover: Full vs Training Data", x = "Month", y = "Turnover") +
theme_minimal()
### Exercise 5.7.C #Fit a seasonal naive model to the training data
fit <- myseries_train_agg |>
model(SNAIVE(Turnover))
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()`).
### Exercise 5.7.E. #Produce forecasts for the test data
new_aus <- aus_agg |>
filter(year(Month) >= 2011)
fc <- fit |>
forecast(new_data = new_aus)
autoplot(myseries_train_agg, Turnover) +
autolayer(fc, Turnover) +
labs(title = "Ten YearAggregated Retail Turnover Forecast", x = "Month", y = "Turnover") +
theme_minimal()
### Exercise 5.7.F. Compare the accuracy of the forecasts
fc_accuracy <- fc |>
accuracy(aus_agg)
fc_accuracy
#The seasonal naïve model is not very sensitive to the amount of training data used because it simply repeats the most recent seasonal cycle. Adding more historical data does not substantially change the forecasts. Accuracy may vary slightly if there are structural changes in the series, but overfitting is not a concern since the model does not estimate parameters.