library(fpp3)
pop_model <- global_economy |>
filter(Country == "Australia") |>
model(RW(Population ~ drift()))
pop_forecast <- pop_model |> forecast(h = 10)
autoplot(global_economy |> filter(Country == "Australia"), Population) +
autolayer(pop_forecast, series = "Forecast") +
labs(title = "Forecast for Australian Population",
x = "Year", y = "Population (Millions)") +
theme_minimal()
The forecast follows the strong upward trend in population growth. The prediction interval is relatively narrow, indicating low uncertainty.
bricks_model <- aus_production |>
filter(!is.na(Bricks)) |>
model(SNAIVE(Bricks))
bricks_forecast <- bricks_model |> forecast(h = "2 years")
autoplot(aus_production, Bricks) +
autolayer(bricks_forecast, series = "Forecast") +
labs(title = "Forecast for Bricks Production",
x = "Year", y = "Bricks (Millions)") +
theme_minimal()
The forecast follows a strong upward trend in the frist half, with a general downtrend in teh second half. The prediction interval is wide, indicating high uncertainty.
lambs_model <- aus_livestock |>
filter(State == "New South Wales", Animal == "Lambs") |>
model(SNAIVE(Count))
lambs_forecast <- lambs_model |> forecast(h = "2 years")
autoplot(aus_livestock |> filter(State == "New South Wales", Animal == "Lambs"), Count) +
autolayer(lambs_forecast, series = "Forecast") +
labs(title = "Forecast for NSW Lamb Slaughter",
x = "Year", y = "Count (Thousands)") +
theme_minimal()
The forecast captures strong seasonality, with fluctuations following past slaughtering cycles. The prediction intervals expand significantly, indicating increased uncertainty in future projections.
wealth_model <- hh_budget |>
model(RW(Wealth ~ drift()))
wealth_forecast <- wealth_model |> forecast(h = 10)
autoplot(hh_budget, Wealth) +
autolayer(wealth_forecast, series = "Forecast") +
labs(title = "Forecast for Household Wealth",
x = "Year", y = "Wealth (Billions AUD)") +
theme_minimal()
Wealth has a clear increasing trend, but uncertainty widens significantly in future projections. Different countries show varied growth rates, with the USA having the highest projections.
takeaway_model <- aus_retail |>
filter(Industry == "Takeaway food services") |>
model(SNAIVE(Turnover))
takeaway_forecast <- takeaway_model |> forecast(h = "2 years")
autoplot(aus_retail |> filter(Industry == "Takeaway food services"), Turnover) +
autolayer(takeaway_forecast, series = "Forecast") +
labs(title = "Forecast for Takeaway Food Turnover",
x = "Year", y = "Turnover (Million AUD)") +
theme_minimal()
options(repr.plot.width = 14, repr.plot.height = 7)
autoplot(aus_retail |> filter(Industry == "Takeaway food services"), Turnover) +
autolayer(takeaway_forecast, series = "Forecast") +
labs(title = "Forecast for Takeaway Food Turnover",
x = "Year", y = "Turnover (Million AUD)") +
theme_minimal() +
theme(
legend.position = "bottom",
legend.direction = "horizontal",
legend.box = "horizontal",
legend.spacing.x = unit(0.3, "cm"),
legend.key.size = unit(0.3, "cm"),
legend.key.height = unit(0.2, "cm"),
legend.key.width = unit(0.8, "cm"),
legend.text = element_text(size = 8),
legend.text.align = 0)
The forecast captures strong seasonal effects, with each state following its historical pattern. Prediction intervals expand slightly, indicating moderate uncertainty.
facebook_stock <- gafa_stock |> filter(Symbol == "FB")
autoplot(facebook_stock, Close) +
labs(title = "Facebook Stock Price Over Time",
x = "Year", y = "Stock Price (USD)") +
theme_minimal()
The trend is clearly upward, with some fluctuation, except the last few years.
fb_stock <- gafa_stock |> filter(Symbol == "FB")
fb_stock <- fb_stock |>
mutate(trading_day = row_number()) |>
update_tsibble(index = trading_day, regular = TRUE)
fb_stock |>
model(RW(Close ~ drift())) |>
forecast(h = 80) |>
autoplot(fb_stock) +
labs(title = "Drift Forecast for Facebook Stock Price",
x = "Trading Day", y = "Stock Price (USD)") +
theme_minimal()
slope <- (last(fb_stock$Close) - first(fb_stock$Close)) / (nrow(fb_stock) - 1)
fb_stock <- fb_stock |>
mutate(Drift_Line = first(Close) + slope * (trading_day - first(trading_day)))
autoplot(fb_stock, Close) +
autolayer(fb_stock, Drift_Line, color = "red", linetype = "dashed") +
autolayer(
fb_stock |> model(RW(Close ~ drift())) |> forecast(h = 80),
series = "Drift Forecast"
) +
labs(
title = "Drift Method Forecast vs. First-to-Last Line",
x = "Trading Day", y = "Stock Price (USD)"
) +
theme_minimal()
fb_models <- fb_stock |> model(
Naive = NAIVE(Close),
Seasonal_Naive = SNAIVE(Close),
Mean = MEAN(Close),
Drift = RW(Close ~ drift()))
fb_forecasts <- fb_models |> forecast(h = 80)
autoplot(fb_stock, Close) +
autolayer(fb_forecasts, series = "Forecast") +
labs(
title = "Comparison of Benchmark Forecasts for Facebook Stock Price",
x = "Trading Day", y = "Stock Price (USD)"
) +
facet_wrap(~ .model, scales = "free_y") +
theme_minimal()
The Drift Model is the best choice because:
What do you conclude?
recent_production <- aus_production |>
filter(year(Quarter) >= 1992)
fit <- recent_production |> model(SNAIVE(Beer))
fit |> gg_tsresiduals()
fit |> forecast(h = "3 years") |> autoplot(recent_production) +
labs(title = "Seasonal Naïve Forecast for Australian Beer Production",
x = "Year", y = "Beer Production (Million Liters)") +
theme_minimal()
Residuals fluctuate randomly without clear patterns. Most autocorrelations are within the blue confidence bands, meaning there is no strong correlation between past residuals. So the model captures most of the seasonality.
The distribution appears approximately symmetric, suggesting residuals might be normally distributed. Since there are no strong autocorrelation patterns, the Seasonal Naïve model is reasonable.
The forecast perfectly repeats the past seasonal pattern, which is expected for a purely seasonal model. Prediction intervals widen over time, reflecting increasing uncertainty. The model assumes no long-term trend
# NAIVE()
aus_exports <- global_economy |>
filter(Country == "Australia") |>
select(Year, Exports) |>
as_tsibble(index = Year)
autoplot(aus_exports, Exports) +
labs(title = "Australian Exports Over Time",
x = "Year", y = "Exports (% of GDP)") +
theme_minimal()
# a Naïve model
exports_fit <- aus_exports |> model(NAIVE(Exports))
exports_forecast <- exports_fit |> forecast(h = 10)
autoplot(aus_exports, Exports) +
autolayer(exports_forecast, series = "Naïve Forecast") +
labs(title = "Naïve Forecast for Australian Exports",
x = "Year", y = "Exports (% of GDP)") +
theme_minimal()
The Naïve forecast assumes that future values will be the same as the most recent observation, leading to a flat forecast line with widening prediction intervals over time. Given that Australian exports exhibit an upward trend with fluctuations, this method does not account for growth or seasonality. The increasing uncertainty in the prediction intervals suggests that this approach may not be the best for long-term forecasting, and a trend-based model (eg, RW(drift()) or ARIMA()) might provide more reliable projections.
bricks <- aus_production |>
select(Quarter, Bricks) |>
as_tsibble(index = Quarter)
autoplot(bricks, Bricks) +
labs(title = "Bricks Production in Australia",
x = "Year", y = "Bricks (Millions)") +
theme_minimal()
tidy_bricks <- aus_production |>
filter(!is.na(Bricks)) |>
as_tsibble(index = Quarter)
fit <- tidy_bricks |> model(SNAIVE(Bricks))
fit |> gg_tsresiduals()
fit |>
forecast(h = "3 years") |>
autoplot(tidy_bricks) +
labs(title = "Seasonal Naïve Forecast for Australian Bricks Production",
x = "Year", y = "Bricks (Millions)") +
theme_minimal()
###
tidy_bricks <- aus_production |>
filter(!is.na(Bricks)) |>
as_tsibble(index = Quarter)
fit_naive <- tidy_bricks |> model(NAIVE(Bricks))
fit_naive |> gg_tsresiduals()
fit_naive |>
forecast(h = "3 years") |>
autoplot(tidy_bricks) +
labs(title = "Naïve Forecast for Australian Bricks Production",
x = "Year", y = "Bricks (Millions)") +
theme_minimal()
Residuals fluctuate with some structure, suggesting potential autocorrelation. There are some large deviations, indicating the model might not capture all patterns.
Several lags exceed the blue confidence bands, meaning residuals are not white noise. This suggests that the Seasonal Naive model does not fully capture all seasonal dependencies.
The residuals appear roughly normal but show some skew. There are a few extreme residuals, suggesting outliers or structural breaks. The model does not fully explain the seasonal structure—autocorrelation remains.
The forecast follows a repeating seasonal pattern (which is expected from SNAIVE()). Prediction intervals widen over time, indicating increasing uncertainty.
But having applied both NAIVE() and SNAIVE(), the latter is the better model.
vic_livestock <- aus_livestock %>%
filter(State == "Victoria")
snaive_forecasts <- vic_livestock %>%
model(SNAIVE(Count)) %>%
forecast(h = "2 years")
options(repr.plot.width = 12, repr.plot.height = 8)
snaive_forecasts %>%
autoplot(vic_livestock, level = NULL) +
labs(title = "Seasonal Naïve Forecasts for Victorian Livestock Series",
y = "Livestock Count",
x = "Year") +
facet_wrap(~ Animal, scales = "free_y", ncol = 2) +
theme_minimal() +
theme(
strip.text = element_text(size = 12, face = "bold"),
axis.text.x = element_text(size = 10, angle = 45, hjust = 1),
axis.text.y = element_text(size = 10),
axis.title = element_text(size = 12),
panel.spacing = unit(1.5, "lines"),
plot.title = element_text(size = 16, face = "bold", hjust = 0.5)) +
scale_y_continuous(labels = scales::comma)
SNAIVE is a reasonable benchmark for these livestock series if seasonality is strong and stable, as seen in Calves. However, it fails to capture trends in series like Lambs and Pigs and won’t adapt to structural changes. For long-term forecasting, ARIMA or ETS models may perform better.