Nothing
# ---- PROPHET BOOST ----
context("TEST prophet_boost: prophet_xgboost")
# SETUP ----
# Data
m750 <- m4_monthly %>% filter(id == "M750")
# Split Data 80/20
splits <- initial_time_split(m750, prop = 0.8)
# Model Spec
model_spec <- prophet_boost(
growth = 'linear',
changepoint_num = 10,
changepoint_range = 0.75,
seasonality_yearly = TRUE,
seasonality_weekly = FALSE,
seasonality_daily = FALSE,
season = 'multiplicative',
prior_scale_changepoints = 20,
prior_scale_seasonality = 20,
prior_scale_holidays = 20,
#xgboost
mtry = 25,
trees = 250,
min_n = 4,
learn_rate = 0.1,
tree_depth = 7,
loss_reduction = 0.4,
sample_size = 0.9
) %>%
set_engine("prophet_xgboost")
# PARSNIP ----
# * NO XREGS ----
test_that("prophet_boost: No Xregs", {
testthat::skip_on_cran()
# ** MODEL FIT ----
# Model Fit
model_fit <- model_spec %>%
fit(log(value) ~ date, data = training(splits))
# Structure
testthat::expect_s3_class(model_fit$fit, "prophet_xgboost_fit_impl")
testthat::expect_s3_class(model_fit$fit$data, "tbl_df")
testthat::expect_equal(names(model_fit$fit$data)[1], "date")
testthat::expect_true(is.null(model_fit$fit$extras$xreg_recipe))
# $fit PROPHET
testthat::expect_s3_class(model_fit$fit$models$model_1, "prophet")
testthat::expect_identical(model_fit$fit$models$model_1$growth, "linear")
testthat::expect_identical(model_fit$fit$models$model_1$n.changepoints, 10)
testthat::expect_identical(model_fit$fit$models$model_1$changepoint.range, 0.75)
testthat::expect_identical(model_fit$fit$models$model_1$yearly.seasonality, TRUE)
testthat::expect_identical(model_fit$fit$models$model_1$weekly.seasonality, FALSE)
testthat::expect_identical(model_fit$fit$models$model_1$daily.seasonality, FALSE)
testthat::expect_identical(model_fit$fit$models$model_1$seasonality.mode, 'multiplicative')
testthat::expect_identical(model_fit$fit$models$model_1$seasonality.prior.scale, 20)
testthat::expect_identical(model_fit$fit$models$model_1$changepoint.prior.scale, 20)
testthat::expect_identical(model_fit$fit$models$model_1$holidays.prior.scale, 20)
testthat::expect_identical(model_fit$fit$models$model_1$uncertainty.samples, 0)
# $preproc
testthat::expect_equal(model_fit$preproc$y_var, "value")
# ** PREDICTIONS ----
# Predictions
predictions_tbl <- model_fit %>%
modeltime_calibrate(testing(splits)) %>%
modeltime_forecast(new_data = testing(splits))
# Structure
testthat::expect_identical(nrow(testing(splits)), nrow(predictions_tbl))
testthat::expect_identical(testing(splits)$date, predictions_tbl$.index)
# Out-of-Sample Accuracy Tests
resid <- testing(splits)$value - exp(predictions_tbl$.value)
# - Max Error less than 1500
testthat::expect_lte(max(abs(resid)), 1500)
# - MAE less than 700
testthat::expect_lte(mean(abs(resid)), 700)
})
# * XREGS ----
test_that("prophet_boost: prophet, XREGS", {
# ** MODEL FIT ----
# Model Fit
model_fit <- model_spec %>%
fit(log(value) ~ date + as.numeric(date) + factor(month(date, label = TRUE), ordered = F),
data = training(splits))
# Structure
testthat::expect_s3_class(model_fit$fit, "prophet_xgboost_fit_impl")
testthat::expect_s3_class(model_fit$fit$data, "tbl_df")
testthat::expect_equal(names(model_fit$fit$data)[1], "date")
testthat::expect_true(!is.null(model_fit$fit$extras$xreg_recipe))
# $fit PROPHET
testthat::expect_s3_class(model_fit$fit$models$model_1, "prophet")
testthat::expect_identical(model_fit$fit$models$model_1$growth, "linear")
testthat::expect_identical(model_fit$fit$models$model_1$n.changepoints, 10)
testthat::expect_identical(model_fit$fit$models$model_1$changepoint.range, 0.75)
testthat::expect_identical(model_fit$fit$models$model_1$yearly.seasonality, TRUE)
testthat::expect_identical(model_fit$fit$models$model_1$weekly.seasonality, FALSE)
testthat::expect_identical(model_fit$fit$models$model_1$daily.seasonality, FALSE)
testthat::expect_identical(model_fit$fit$models$model_1$seasonality.mode, 'multiplicative')
testthat::expect_identical(model_fit$fit$models$model_1$seasonality.prior.scale, 20)
testthat::expect_identical(model_fit$fit$models$model_1$changepoint.prior.scale, 20)
testthat::expect_identical(model_fit$fit$models$model_1$holidays.prior.scale, 20)
testthat::expect_identical(model_fit$fit$models$model_1$uncertainty.samples, 0)
# $fit xgboost
testthat::expect_s3_class(model_fit$fit$models$model_2, "xgb.Booster")
testthat::expect_identical(model_fit$fit$models$model_2$params$eta, 0.1)
testthat::expect_identical(model_fit$fit$models$model_2$params$max_depth, 7)
testthat::expect_identical(model_fit$fit$models$model_2$params$gamma, 0.4)
testthat::expect_identical(model_fit$fit$models$model_2$params$colsample_bytree, 1)
testthat::expect_identical(model_fit$fit$models$model_2$params$min_child_weight, 4)
testthat::expect_identical(model_fit$fit$models$model_2$params$subsample, 0.9)
testthat::expect_identical(model_fit$fit$models$model_2$params$objective, "reg:squarederror")
# $preproc
testthat::expect_equal(model_fit$preproc$y_var, "value")
# ** PREDICTIONS ----
# Predictions
predictions_tbl <- model_fit %>%
modeltime_calibrate(testing(splits)) %>%
modeltime_forecast(new_data = testing(splits))
# Structure
testthat::expect_identical(nrow(testing(splits)), nrow(predictions_tbl))
testthat::expect_identical(testing(splits)$date, predictions_tbl$.index)
# Out-of-Sample Accuracy Tests
resid <- testing(splits)$value - exp(predictions_tbl$.value)
# - Max Error less than 1500
testthat::expect_lte(max(abs(resid)), 1500)
# - MAE less than 700
testthat::expect_lte(mean(abs(resid)), 700)
})
# ---- WORKFLOWS ----
# TESTS
test_that("prophet_boost: prophet_xgboost (workflow)", {
testthat::skip_on_cran()
#
# Recipe spec
recipe_spec <- recipe(value ~ date, data = training(splits)) %>%
step_log(value, skip = FALSE) %>%
step_date(date, features = "month") %>%
step_mutate(date_num = as.numeric(date))
# Workflow
wflw <- workflow() %>%
add_recipe(recipe_spec) %>%
add_model(model_spec)
# Fitted Workflow
wflw_fit <- wflw %>%
fit(training(splits))
# Structure
testthat::expect_s3_class(wflw_fit$fit$fit$fit, "prophet_xgboost_fit_impl")
testthat::expect_s3_class(wflw_fit$fit$fit$fit$data, "tbl_df")
testthat::expect_equal(names(wflw_fit$fit$fit$fit$data)[1], "date")
testthat::expect_true(!is.null(wflw_fit$fit$fit$fit$extras$xreg_recipe))
# $fit prophet
testthat::expect_s3_class(wflw_fit$fit$fit$fit$models$model_1, "prophet")
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$growth, "linear")
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$n.changepoints, 10)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$changepoint.range, 0.75)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$yearly.seasonality, TRUE)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$weekly.seasonality, FALSE)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$daily.seasonality, FALSE)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$seasonality.mode, 'multiplicative')
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$seasonality.prior.scale, 20)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$changepoint.prior.scale, 20)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$holidays.prior.scale, 20)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_1$uncertainty.samples, 0)
# $fit xgboost
testthat::expect_s3_class(wflw_fit$fit$fit$fit$models$model_2, "xgb.Booster")
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_2$params$eta, 0.1)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_2$params$max_depth, 7)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_2$params$gamma, 0.4)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_2$params$colsample_bytree, 1)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_2$params$min_child_weight, 4)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_2$params$subsample, 0.9)
testthat::expect_identical(wflw_fit$fit$fit$fit$models$model_2$params$objective, "reg:squarederror")
# $preproc
mld <- wflw_fit %>% workflows::extract_mold()
testthat::expect_equal(names(mld$outcomes), "value")
# ** PREDICTIONS ----
# Forecast
predictions_tbl <- wflw_fit %>%
modeltime_calibrate(testing(splits)) %>%
modeltime_forecast(new_data = testing(splits), actual_data = training(splits)) %>%
mutate_at(vars(.value), exp)
full_data <- bind_rows(training(splits), testing(splits))
# Structure
testthat::expect_identical(nrow(full_data), nrow(predictions_tbl))
testthat::expect_identical(full_data$date, predictions_tbl$.index)
# Out-of-Sample Accuracy Tests
predictions_tbl <- predictions_tbl %>% filter(.key == "prediction")
resid <- testing(splits)$value - predictions_tbl$.value
# - Max Error less than 1500
testthat::expect_lte(max(abs(resid)), 1500)
# - MAE less than 700
testthat::expect_lte(mean(abs(resid)), 700)
})
# LOGISTIC GROWTH ----
# * MODELS ----
test_that("prophet_reg: prophet, Logistic Growth", {
testthat::skip_on_cran()
# ** MODEL FIT ----
# Model Fit
model_fit <- prophet_boost(
growth = "logistic",
logistic_cap = 11000,
seasonality_yearly = FALSE,
seasonality_weekly = FALSE,
seasonality_daily = FALSE
) %>%
set_engine(engine = "prophet_xgboost") %>%
fit(value ~ date
+ as.numeric(date)
+ month(date, label = TRUE)
+ fourier_vec(date, period = 12),
data = m750)
# Structure
testthat::expect_s3_class(model_fit$fit, "prophet_xgboost_fit_impl")
testthat::expect_s3_class(model_fit$fit$data, "tbl_df")
testthat::expect_equal(names(model_fit$fit$data)[1], "date")
testthat::expect_false(is.null(model_fit$fit$extras$logistic_params$logistic_cap))
# $fit PROPHET
testthat::expect_s3_class(model_fit$fit$models$model_1, "prophet")
testthat::expect_identical(model_fit$fit$models$model_1$growth, "logistic")
testthat::expect_identical(model_fit$fit$extras$logistic_params$growth, "logistic")
testthat::expect_identical(model_fit$fit$extras$logistic_params$logistic_cap, 11000)
testthat::expect_true(is.null(model_fit$fit$extras$logistic_params$logistic_floor))
# $preproc
testthat::expect_equal(model_fit$preproc$y_var, "value")
# ** PREDICTIONS ----
forecast_prophet_logisitic <- modeltime_table(
model_fit
) %>%
modeltime_forecast(
h = 12 * 10,
actual_data = m750
) %>%
filter(.model_desc != "ACTUAL")
expect_lte(
forecast_prophet_logisitic$.value %>% max(),
11500
)
# ERROR IF CAP/FLOOR NOT SPECIFIED
expect_error({
prophet_boost(
growth = "logistic"
) %>%
set_engine(engine = "prophet_xgboost") %>%
fit(value ~ date, m750)
})
})
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.