Module_10_Discussion

Author

Tin Vu

#loading data set
livestock <- tsibbledata::aus_livestock

#split first
all_months   <- sort(unique(livestock$Month))
train_months <- head(all_months, -24)
test_months  <- tail(all_months, 24)

train <- livestock |>
  filter(Month %in% train_months)

test <- livestock |>
  filter(Month %in% test_months)

#building hierarchy 
train_hts_as <- train |>
  aggregate_key(Animal / State, Count = sum(Count)
)

test_hts_as <- test |>
  aggregate_key(Animal / State, Count = sum(Count)
)

#declaring structure
livestock_hts_as <- livestock |>
  aggregate_key(Animal / State, Count = sum(Count)
)

n_animal <- n_distinct(livestock$Animal)

n_bottom <- livestock |>
  distinct(Animal, State) |>
  nrow()

counts_tbl <- tibble(
  structure = "HTS: Animal / State",
  unique_series = 1 + n_animal + n_bottom,
  unique_levels = "Total, Animal, Animal:State"
)

counts_tbl

# A tibble: 1 × 3
  structure           unique_series unique_levels              
  <chr>                       <dbl> <chr>                      
1 HTS: Animal / State            62 Total, Animal, Animal:State

fit_hts <- train_hts_as |>
  model(
    ets = ETS(Count)
)

recon_hts <- fit_hts |>
  reconcile(
    top_dn = top_down(ets, method = "forecast_proportions"),
    midout    = middle_out(ets, split = 1),
    mint  = min_trace(ets, method = "mint_shrink")
)

#forecast and compare
fc_hts <- recon_hts |>
  forecast(h = 24)

#overall plot
fc_hts |>
  filter(is_aggregated(Animal), is_aggregated(State)) |>
  autoplot(livestock_hts_as, 
           level = NULL) +
  labs(
    title = "Total Livestock Count Forecast",
    subtitle = "Top-Down vs Middle-Out vs MinT",
    y = "Count",
    x = "Month") +
  coord_cartesian(xlim = c(yearmonth("2016 Jan"), NA)) +
  theme_minimal()

fc_hts |>
  filter(Animal == "Lambs", is_aggregated(State)) |>
  autoplot(livestock_hts_as, level = NULL) +
  labs(
    title = "Lambs Forecast",
    subtitle = "Top-Down vs Middle-Out vs MinT",
    y = "Count",
    x = "Month") +
  coord_cartesian(xlim = c(yearmonth("2016 Jan"), NA)) +
  theme_minimal()

#building accuracy table  
acc_hts <- fc_hts |>
  accuracy(
    test_hts_as,
    measures = list(RMSE = RMSE, MAE = MAE, MAPE = MAPE)
)

acc_summary <- acc_hts |>
  filter(.model != "ets") |>
  group_by(.model) |>
  summarise(
    RMSE = mean(RMSE, na.rm = TRUE),
    MAE = mean(MAE, na.rm = TRUE),
    MAPE = mean(MAPE, na.rm = TRUE),
    .groups = "drop"
  ) |>
  arrange(RMSE)

acc_summary

# A tibble: 3 × 4
  .model   RMSE    MAE  MAPE
  <chr>   <dbl>  <dbl> <dbl>
1 midout 29618. 23299.   Inf
2 mint   30168. 23704.   Inf
3 top_dn 31350. 24634.   Inf

train_total <- train_hts_as |>
  filter(is_aggregated(Animal), is_aggregated(State)) |>
  select(Month, Actual = Count)

fit_total <- augment(fit_hts) |>
  filter(is_aggregated(Animal), is_aggregated(State)) |>
  select(Month, Fitted = .fitted)

plot_data <- train_total |>
  left_join(fit_total, by = "Month") |>
  pivot_longer(
    cols = c(Actual, Fitted),
    names_to = "Series",
    values_to = "Count"
  ) |>
  as_tsibble(index = Month, key = Series)

autoplot(plot_data, Count) +
  coord_cartesian(xlim = c(yearmonth("2010 Jan"), max(train$Month))) +
  labs(
    title = "Fitted Values on Training Data: Total Livestock",
    subtitle = "Actual vs Fitted",
    y = "Count",
    x = "Month",
    colour = NULL) +
  theme_minimal()

fc_hts |>
  filter(is_aggregated(Animal), is_aggregated(State), 
         .model != "ets") |>
  autoplot(livestock_hts_as, level = NULL) +
  coord_cartesian(xlim = c(yearmonth("2016 Jan"), max(livestock$Month))) +
  labs(
    title = "Test Period: Total Livestock Actual vs Forecast",
    subtitle = "Actual compared with Top-Down, Middle-Out, and MinT",
    y = "Count",
    x = "Month"
  ) +
  theme_minimal()

fc_hts |>
  filter(Animal == "Lambs", is_aggregated(State), 
         .model != "ets") |>
  autoplot(livestock_hts_as, level = NULL) +
  coord_cartesian(xlim = c(yearmonth("2016 Jan"), max(livestock$Month))) +
  labs(
    title = "Test Period: Lambs Actual vs Forecast",
    subtitle = "Actual compared with Top-Down, Middle-Out, and MinT",
    y = "Count",
    x = "Month") +
  theme_minimal()

Other Formats