Nothing
context("PANEL DATA")
# SETUP ----
m4_monthly_jumbled <- m4_monthly %>%
arrange(desc(date))
data_set <- m4_monthly_jumbled
recipe_spec <- recipe(value ~ date + id, data_set) %>%
step_mutate(date_num = as.numeric(date)) %>%
step_mutate(month_lbl = lubridate::month(date, label = TRUE)) %>%
step_dummy(all_nominal(), one_hot = TRUE)
set.seed(123)
wflw_fit_prophet_boost <- workflow() %>%
add_model(
prophet_boost(
seasonality_yearly = F,
seasonality_weekly = F,
seasonality_daily = F
) %>%
set_engine("prophet_xgboost")) %>%
add_recipe(recipe_spec) %>%
fit(data_set)
set.seed(123)
wflw_fit_xgb <- workflow() %>%
add_model(boost_tree("regression") %>% set_engine("xgboost")) %>%
add_recipe(recipe_spec %>% step_rm(date)) %>%
fit(data_set)
# AVERAGE ENSEMBLE ----
test_that("ensemble_average(): Forecast Jumbled", {
submodel_tbl <- modeltime_table(
wflw_fit_prophet_boost,
wflw_fit_xgb
)
# submodel_tbl %>%
# modeltime_calibrate(data_set) %>%
# modeltime_accuracy()
model_tbl <- submodel_tbl %>%
ensemble_average() %>%
modeltime_table()
# Forecast
fcast <- model_tbl %>%
modeltime_forecast(data_set)
expect_equal(nrow(fcast), nrow(data_set))
expect_equal(fcast$.index, data_set$date)
# Calibration
calibration_tbl <- model_tbl %>%
modeltime_calibrate(data_set)
expect_equal(calibration_tbl$.type, c("Test"))
expect_contains(names(calibration_tbl), c(".type", ".calibration_data"))
expect_equal(nrow(data_set), calibration_tbl %>% pluck(".calibration_data", 1) %>% nrow())
# Accuracy
accuracy_tbl <- calibration_tbl %>%
modeltime_accuracy()
expect_false(anyNA(accuracy_tbl$mae))
expect_true(all(is.double(accuracy_tbl$mae)))
expect_true(accuracy_tbl$mae < 500)
# * Forecast ----
forecast_tbl <- calibration_tbl %>%
modeltime_forecast(
new_data = data_set,
actual_data = data_set,
keep_data = TRUE,
arrange_index = FALSE
)
# forecast_tbl %>% group_by(id) %>% plot_modeltime_forecast()
# * Test Actual ----
actual_tbl <- forecast_tbl %>%
filter(.key == "actual")
expect_equal(nrow(actual_tbl), nrow(data_set))
expect_equal(actual_tbl$.value, actual_tbl$value)
# * Test Ensemble ----
ensemble_tbl <- forecast_tbl %>%
filter(.key == "prediction")
expect_equal(nrow(ensemble_tbl), nrow(data_set))
expect_equal(ensemble_tbl$.index, ensemble_tbl$date)
})
# WEIGHTED ENSEMBLE ----
test_that("ensemble_weighted(): Forecast Jumbled", {
loadings <- c(3, 1)
model_tbl <- modeltime_table(
wflw_fit_prophet_boost,
wflw_fit_xgb
) %>%
ensemble_weighted(loadings) %>%
modeltime_table()
# Forecast
fcast <- model_tbl %>%
modeltime_forecast(data_set)
expect_equal(nrow(fcast), nrow(data_set))
expect_equal(fcast$.index, data_set$date)
# Calibration
calibration_tbl <- model_tbl %>%
modeltime_calibrate(data_set)
expect_equal(calibration_tbl$.type, c("Test"))
expect_contains(names(calibration_tbl), c(".type", ".calibration_data"))
expect_equal(nrow(data_set), calibration_tbl %>% pluck(".calibration_data", 1) %>% nrow())
# Accuracy
accuracy_tbl <- calibration_tbl %>%
modeltime_accuracy()
expect_false(anyNA(accuracy_tbl$mae))
expect_true(all(is.double(accuracy_tbl$mae)))
expect_true(accuracy_tbl$mae < 400)
# * Forecast ----
forecast_tbl <- calibration_tbl %>%
modeltime_forecast(
new_data = data_set,
actual_data = data_set,
keep_data = TRUE,
arrange_index = FALSE
)
# forecast_tbl %>% group_by(id) %>% plot_modeltime_forecast()
# * Test Actual ----
actual_tbl <- forecast_tbl %>%
filter(.key == "actual")
expect_equal(nrow(actual_tbl), nrow(data_set))
expect_equal(actual_tbl$.value, actual_tbl$value)
# * Test Ensemble ----
ensemble_tbl <- forecast_tbl %>%
filter(.key == "prediction")
expect_equal(nrow(ensemble_tbl), nrow(data_set))
expect_equal(ensemble_tbl$.index, ensemble_tbl$date)
})
# STACKED ENSEMBLE ----
test_that("ensemble_model_spec(): Forecast Jumbled", {
resamples_tscv <- data_set %>%
time_series_cv(assess = "2 years", initial = "5 years", skip = "2 years", slice_limit = 2)
resample_tscv <- modeltime_table(
wflw_fit_prophet_boost,
wflw_fit_xgb
) %>%
modeltime_fit_resamples(resamples_tscv, control = control_resamples(verbose = F))
ensemble_fit <- resample_tscv %>%
ensemble_model_spec(
model_spec = linear_reg() %>% set_engine("lm"),
grid = 3,
control = control_grid(verbose = FALSE)
)
model_tbl <- modeltime_table(
ensemble_fit
)
# Forecast
fcast <- model_tbl %>%
modeltime_forecast(data_set)
expect_equal(nrow(fcast), nrow(data_set))
expect_equal(fcast$.index, data_set$date)
# Calibration
calibration_tbl <- model_tbl %>%
modeltime_calibrate(data_set, quiet = FALSE)
expect_equal(calibration_tbl$.type, c("Test"))
expect_contains(names(calibration_tbl), c(".type", ".calibration_data"))
expect_equal(nrow(data_set), calibration_tbl %>% pluck(".calibration_data", 1) %>% nrow())
# Accuracy
accuracy_tbl <- calibration_tbl %>%
modeltime_accuracy()
expect_false(anyNA(accuracy_tbl$mae))
expect_true(all(is.double(accuracy_tbl$mae)))
# * Forecast ----
forecast_tbl <- calibration_tbl %>%
modeltime_forecast(
new_data = data_set,
actual_data = data_set,
keep_data = TRUE,
arrange_index = FALSE
)
# * Test Actual ----
actual_tbl <- forecast_tbl %>%
filter(.key == "actual")
expect_equal(nrow(actual_tbl), nrow(data_set))
expect_equal(actual_tbl$.value, actual_tbl$value)
# * Test Ensemble ----
ensemble_tbl <- forecast_tbl %>%
filter(.key == "prediction")
expect_equal(nrow(ensemble_tbl), nrow(data_set))
expect_equal(ensemble_tbl$.index, ensemble_tbl$date)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.