mirror of
https://github.com/saymrwulf/prophet.git
synced 2026-07-23 19:32:25 +00:00
Multiplicative seasonality (R)
This commit is contained in:
Ben Letham
parent
f1e24d3c2c
commit
7c010aac51
20 changed files with 489 additions and 153 deletions
|
|
@ -179,6 +179,7 @@ prophet_copy <- function(m, cutoff = NULL) {
|
|||
weekly.seasonality = FALSE,
|
||||
daily.seasonality = FALSE,
|
||||
holidays = m$holidays,
|
||||
seasonality.mode = m$seasonality.mode,
|
||||
seasonality.prior.scale = m$seasonality.prior.scale,
|
||||
changepoint.prior.scale = m$changepoint.prior.scale,
|
||||
holidays.prior.scale = m$holidays.prior.scale,
|
||||
|
|
@ -253,7 +254,7 @@ performance_metrics <- function(df, metrics = NULL, rolling_window = 0.1) {
|
|||
cols <- c(cols, metric)
|
||||
}
|
||||
df_m <- df_m[cols]
|
||||
return(na.omit(df_m))
|
||||
return(stats::na.omit(df_m))
|
||||
}
|
||||
|
||||
#' Compute a rolling mean of x
|
||||
|
|
|
|||
54
R/R/plot.R
54
R/R/plot.R
|
|
@ -69,8 +69,9 @@ plot.prophet <- function(x, fcst, uncertainty = TRUE, plot_cap = TRUE,
|
|||
}
|
||||
|
||||
#' Plot the components of a prophet forecast.
|
||||
#' Prints a ggplot2 with panels for trend, weekly and yearly seasonalities if
|
||||
#' present, and holidays if present.
|
||||
#' Prints a ggplot2 with whichever are available of: trend, holidays, weekly
|
||||
#' seasonality, yearly seasonality, and additive and multiplicative extra
|
||||
#' regressors.
|
||||
#'
|
||||
#' @param m Prophet object.
|
||||
#' @param fcst Data frame returned by predict(m, df).
|
||||
|
|
@ -94,11 +95,12 @@ prophet_plot_components <- function(
|
|||
yearly_start = 0
|
||||
) {
|
||||
# Plot the trend
|
||||
panels <- list(plot_forecast_component(fcst, 'trend', uncertainty, plot_cap))
|
||||
panels <- list(
|
||||
plot_forecast_component(m, fcst, 'trend', uncertainty, plot_cap))
|
||||
# Plot holiday components, if present.
|
||||
if (!is.null(m$holidays) && ('holidays' %in% colnames(fcst))) {
|
||||
panels[[length(panels) + 1]] <- plot_forecast_component(
|
||||
fcst, 'holidays', uncertainty, FALSE)
|
||||
m, fcst, 'holidays', uncertainty, FALSE)
|
||||
}
|
||||
# Plot weekly seasonality, if present
|
||||
if ("weekly" %in% colnames(fcst)) {
|
||||
|
|
@ -116,10 +118,17 @@ prophet_plot_components <- function(
|
|||
}
|
||||
}
|
||||
# Plot extra regressors
|
||||
if ((length(m$extra_regressors) > 0)
|
||||
& ('extra_regressors' %in% colnames(fcst))) {
|
||||
panels[[length(panels) + 1]] <- plot_forecast_component(
|
||||
fcst, 'extra_regressors', uncertainty, FALSE)
|
||||
regressors <- list(additive = FALSE, multiplicative = FALSE)
|
||||
for (name in names(m$extra_regressors)) {
|
||||
regressors[[m$extra_regressors[[name]]$mode]] <- TRUE
|
||||
}
|
||||
for (mode in c('additive', 'multiplicative')) {
|
||||
if ((regressors[[mode]]) &
|
||||
(paste0('extra_regressors_', mode) %in% colnames(fcst))
|
||||
) {
|
||||
panels[[length(panels) + 1]] <- plot_forecast_component(
|
||||
m, fcst, paste0('extra_regressors_', mode), uncertainty, FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
# Make the plot.
|
||||
|
|
@ -135,6 +144,7 @@ prophet_plot_components <- function(
|
|||
|
||||
#' Plot a particular component of the forecast.
|
||||
#'
|
||||
#' @param m Prophet model
|
||||
#' @param fcst Dataframe output of `predict`.
|
||||
#' @param name String name of the component to plot (column of fcst).
|
||||
#' @param uncertainty Boolean to plot uncertainty intervals.
|
||||
|
|
@ -145,7 +155,7 @@ prophet_plot_components <- function(
|
|||
#'
|
||||
#' @export
|
||||
plot_forecast_component <- function(
|
||||
fcst, name, uncertainty = TRUE, plot_cap = FALSE
|
||||
m, fcst, name, uncertainty = TRUE, plot_cap = FALSE
|
||||
) {
|
||||
gg.comp <- ggplot2::ggplot(
|
||||
fcst, ggplot2::aes_string(x = 'ds', y = name, group = 1)) +
|
||||
|
|
@ -168,6 +178,9 @@ plot_forecast_component <- function(
|
|||
fill = "#0072B2",
|
||||
na.rm = TRUE)
|
||||
}
|
||||
if (name %in% m$component.modes$multiplicative) {
|
||||
gg.comp <- gg.comp + ggplot2::scale_y_continuous(labels = scales::percent)
|
||||
}
|
||||
return(gg.comp)
|
||||
}
|
||||
|
||||
|
|
@ -220,6 +233,11 @@ plot_weekly <- function(m, uncertainty = TRUE, weekly_start = 0) {
|
|||
fill = "#0072B2",
|
||||
na.rm = TRUE)
|
||||
}
|
||||
if (m$seasonalities$weekly$mode == 'multiplicative') {
|
||||
gg.weekly <- (
|
||||
gg.weekly + ggplot2::scale_y_continuous(labels = scales::percent)
|
||||
)
|
||||
}
|
||||
return(gg.weekly)
|
||||
}
|
||||
|
||||
|
|
@ -255,6 +273,11 @@ plot_yearly <- function(m, uncertainty = TRUE, yearly_start = 0) {
|
|||
fill = "#0072B2",
|
||||
na.rm = TRUE)
|
||||
}
|
||||
if (m$seasonalities$yearly$mode == 'multiplicative') {
|
||||
gg.yearly <- (
|
||||
gg.yearly + ggplot2::scale_y_continuous(labels = scales::percent)
|
||||
)
|
||||
}
|
||||
return(gg.yearly)
|
||||
}
|
||||
|
||||
|
|
@ -299,6 +322,9 @@ plot_seasonality <- function(m, name, uncertainty = TRUE) {
|
|||
fill = "#0072B2",
|
||||
na.rm = TRUE)
|
||||
}
|
||||
if (m$seasonalities[[name]]$mode == 'multiplicative') {
|
||||
gg.s <- gg.s + ggplot2::scale_y_continuous(labels = scales::percent)
|
||||
}
|
||||
return(gg.s)
|
||||
}
|
||||
|
||||
|
|
@ -386,8 +412,7 @@ dyplot.prophet <- function(x, fcst, uncertainty=TRUE,
|
|||
dygraphs::dyAnnotation(x, text, text, attachAtBottom = TRUE)
|
||||
}
|
||||
|
||||
dyBase <- dyBase %>%
|
||||
dygraphs::dyOptions(colors = RColorBrewer::brewer.pal(3, "Set1")) %>%
|
||||
dyBase <- dyBase %>%
|
||||
# plot actual values
|
||||
dygraphs::dySeries('y', label=actual.label) %>%
|
||||
# plot forecast and ribbon
|
||||
|
|
@ -399,8 +424,11 @@ dyplot.prophet <- function(x, fcst, uncertainty=TRUE,
|
|||
if (!is.null(x$holidays)) {
|
||||
for (i in 1:nrow(x$holidays)) {
|
||||
# make a gray line
|
||||
dyBase <- dyBase %>% dygraphs::dyEvent(x$holidays$ds[i],color = "rgb(200,200,200)", strokePattern = "solid")
|
||||
dyBase <- dyBase %>% dygraphs::dyAnnotation(x$holidays$ds[i], x$holidays$holiday[i], x$holidays$holiday[i], attachAtBottom = TRUE)
|
||||
dyBase <- dyBase %>% dygraphs::dyEvent(
|
||||
x$holidays$ds[i],color = "rgb(200,200,200)", strokePattern = "solid")
|
||||
dyBase <- dyBase %>% dygraphs::dyAnnotation(
|
||||
x$holidays$ds[i], x$holidays$holiday[i], x$holidays$holiday[i],
|
||||
attachAtBottom = TRUE)
|
||||
}
|
||||
}
|
||||
return(dyBase)
|
||||
|
|
|
|||
306
R/R/prophet.R
306
R/R/prophet.R
|
|
@ -40,6 +40,7 @@ utils::globalVariables(c(
|
|||
#' range of days around the date to be included as holidays. lower_window=-2
|
||||
#' will include 2 days prior to the date as holidays. Also optionally can have
|
||||
#' a column prior_scale specifying the prior scale for each holiday.
|
||||
#' @param seasonality.mode 'additive' (default) or 'multiplicative'.
|
||||
#' @param seasonality.prior.scale Parameter modulating the strength of the
|
||||
#' seasonality model. Larger values allow the model to fit larger seasonal
|
||||
#' fluctuations, smaller values dampen the seasonality. Can be specified for
|
||||
|
|
@ -82,6 +83,7 @@ prophet <- function(df = NULL,
|
|||
weekly.seasonality = 'auto',
|
||||
daily.seasonality = 'auto',
|
||||
holidays = NULL,
|
||||
seasonality.mode = 'additive',
|
||||
seasonality.prior.scale = 10,
|
||||
holidays.prior.scale = 10,
|
||||
changepoint.prior.scale = 0.05,
|
||||
|
|
@ -105,6 +107,7 @@ prophet <- function(df = NULL,
|
|||
weekly.seasonality = weekly.seasonality,
|
||||
daily.seasonality = daily.seasonality,
|
||||
holidays = holidays,
|
||||
seasonality.mode = seasonality.mode,
|
||||
seasonality.prior.scale = seasonality.prior.scale,
|
||||
changepoint.prior.scale = changepoint.prior.scale,
|
||||
holidays.prior.scale = holidays.prior.scale,
|
||||
|
|
@ -122,7 +125,9 @@ prophet <- function(df = NULL,
|
|||
stan.fit = NULL,
|
||||
params = list(),
|
||||
history = NULL,
|
||||
history.dates = NULL
|
||||
history.dates = NULL,
|
||||
train.component.cols = NULL,
|
||||
component.modes = NULL
|
||||
)
|
||||
validate_inputs(m)
|
||||
class(m) <- append("prophet", class(m))
|
||||
|
|
@ -168,6 +173,9 @@ validate_inputs <- function(m) {
|
|||
validate_column_name(m, h, check_holidays = FALSE)
|
||||
}
|
||||
}
|
||||
if (!(m$seasonality.mode %in% c('additive', 'multiplicative'))) {
|
||||
stop("seasonality.mode must be 'additive' or 'multiplicative'")
|
||||
}
|
||||
}
|
||||
|
||||
#' Validates the name of a seasonality, holiday, or regressor.
|
||||
|
|
@ -187,8 +195,9 @@ validate_column_name <- function(
|
|||
stop('Holiday name cannot contain "_delim_"')
|
||||
}
|
||||
reserved_names = c(
|
||||
'trend', 'seasonal', 'seasonalities', 'daily', 'weekly', 'yearly',
|
||||
'holidays', 'zeros', 'extra_regressors', 'yhat'
|
||||
'trend', 'additive_terms', 'daily', 'weekly', 'yearly',
|
||||
'holidays', 'zeros', 'extra_regressors_additive', 'yhat',
|
||||
'extra_regressors_multiplicative', 'multiplicative_terms'
|
||||
)
|
||||
rn_l = paste0(reserved_names,"_lower")
|
||||
rn_u = paste0(reserved_names,"_upper")
|
||||
|
|
@ -511,6 +520,7 @@ make_seasonality_features <- function(dates, period, series.order, prefix) {
|
|||
#' @return A list with entries
|
||||
#' holiday.features: dataframe with a column for each holiday.
|
||||
#' prior.scales: array of prior scales for each holiday column.
|
||||
#' holiday.names: array of names of all holidays.
|
||||
#'
|
||||
#' @importFrom dplyr "%>%"
|
||||
#' @keywords internal
|
||||
|
|
@ -568,7 +578,8 @@ make_holiday_features <- function(m, dates) {
|
|||
prior.scales <- c(prior.scales, prior.scales.list[[sn]])
|
||||
}
|
||||
return(list(holiday.features = holiday.features,
|
||||
prior.scales = prior.scales))
|
||||
prior.scales = prior.scales,
|
||||
holiday.names = names(prior.scales.list)))
|
||||
}
|
||||
|
||||
#' Add an additional regressor to be used for fitting and predicting.
|
||||
|
|
@ -579,6 +590,10 @@ make_holiday_features <- function(m, dates) {
|
|||
#' coefficient is given a prior with the specified scale parameter.
|
||||
#' Decreasing the prior scale will add additional regularization. If no
|
||||
#' prior scale is provided, holidays.prior.scale will be used.
|
||||
#' Mode can be specified as either 'additive' or 'multiplicative'. If not
|
||||
#' specified, m$seasonality.mode will be used. 'additive' means the effect of
|
||||
#' the regressor will be added to the trend, 'multiplicative' means it will
|
||||
#' multiply the trend.
|
||||
#'
|
||||
#' @param m Prophet object.
|
||||
#' @param name String name of the regressor
|
||||
|
|
@ -587,11 +602,15 @@ make_holiday_features <- function(m, dates) {
|
|||
#' @param standardize Bool, specify whether this regressor will be standardized
|
||||
#' prior to fitting. Can be 'auto' (standardize if not binary), True, or
|
||||
#' False.
|
||||
#' @param mode Optional, 'additive' or 'multiplicative'. Defaults to
|
||||
#' m$seasonality.mode.
|
||||
#'
|
||||
#' @return The prophet model with the regressor added.
|
||||
#'
|
||||
#' @export
|
||||
add_regressor <- function(m, name, prior.scale = NULL, standardize = 'auto'){
|
||||
add_regressor <- function(
|
||||
m, name, prior.scale = NULL, standardize = 'auto', mode = NULL
|
||||
){
|
||||
if (!is.null(m$history)) {
|
||||
stop('Regressors must be added prior to model fitting.')
|
||||
}
|
||||
|
|
@ -599,14 +618,21 @@ add_regressor <- function(m, name, prior.scale = NULL, standardize = 'auto'){
|
|||
if (is.null(prior.scale)) {
|
||||
prior.scale <- m$holidays.prior.scale
|
||||
}
|
||||
if (is.null(mode)) {
|
||||
mode <- m$seasonality.mode
|
||||
}
|
||||
if(prior.scale <= 0) {
|
||||
stop("Prior scale must be > 0")
|
||||
}
|
||||
if (!(mode %in% c('additive', 'multiplicative'))) {
|
||||
stop("mode must be 'additive' or 'multiplicative'")
|
||||
}
|
||||
m$extra_regressors[[name]] <- list(
|
||||
prior.scale = prior.scale,
|
||||
standardize = standardize,
|
||||
mu = 0,
|
||||
std = 1.0
|
||||
std = 1.0,
|
||||
mode = mode
|
||||
)
|
||||
return(m)
|
||||
}
|
||||
|
|
@ -622,17 +648,25 @@ add_regressor <- function(m, name, prior.scale = NULL, standardize = 'auto'){
|
|||
#' flexibility, decreasing will dampen it. If not provided, will use the
|
||||
#' seasonality.prior.scale provided on Prophet initialization (defaults to 10).
|
||||
#'
|
||||
#' Mode can be specified as either 'additive' or 'multiplicative'. If not
|
||||
#' specified, m$seasonality.mode will be used (defaults to 'additive').
|
||||
#' Additive means the seasonality will be added to the trend, multiplicative
|
||||
#' means it will multiply the trend.
|
||||
#'
|
||||
#' @param m Prophet object.
|
||||
#' @param name String name of the seasonality component.
|
||||
#' @param period Float number of days in one period.
|
||||
#' @param fourier.order Int number of Fourier components to use.
|
||||
#' @param prior.scale Float prior scale for this component.
|
||||
#' @param prior.scale Optional float prior scale for this component.
|
||||
#' @param mode Optional 'additive' or 'multiplicative'.
|
||||
#'
|
||||
#' @return The prophet model with the seasonality added.
|
||||
#'
|
||||
#' @importFrom dplyr "%>%"
|
||||
#' @export
|
||||
add_seasonality <- function(m, name, period, fourier.order, prior.scale = NULL) {
|
||||
add_seasonality <- function(
|
||||
m, name, period, fourier.order, prior.scale = NULL, mode = NULL
|
||||
) {
|
||||
if (!is.null(m$history)) {
|
||||
stop("Seasonality must be added prior to model fitting.")
|
||||
}
|
||||
|
|
@ -648,10 +682,17 @@ add_seasonality <- function(m, name, period, fourier.order, prior.scale = NULL)
|
|||
if (ps <= 0) {
|
||||
stop('Prior scale must be > 0')
|
||||
}
|
||||
if (is.null(mode)) {
|
||||
mode <- m$seasonality.mode
|
||||
}
|
||||
if (!(mode %in% c('additive', 'multiplicative'))) {
|
||||
stop("mode must be 'additive' or 'multiplicative'")
|
||||
}
|
||||
m$seasonalities[[name]] <- list(
|
||||
period = period,
|
||||
fourier.order = fourier.order,
|
||||
prior.scale = ps
|
||||
prior.scale = ps,
|
||||
mode = mode
|
||||
)
|
||||
return(m)
|
||||
}
|
||||
|
|
@ -667,11 +708,16 @@ add_seasonality <- function(m, name, period, fourier.order, prior.scale = NULL)
|
|||
#' seasonal.features: Dataframe with regressor features,
|
||||
#' prior.scales: Array of prior scales for each colum of the features
|
||||
#' dataframe.
|
||||
#' component.cols: Dataframe with indicators for which regression components
|
||||
#' correspond to which columns.
|
||||
#' modes: List with keys 'additive' and 'multiplicative' with arrays of
|
||||
#' component names for each mode of seasonality.
|
||||
#'
|
||||
#' @keywords internal
|
||||
make_all_seasonality_features <- function(m, df) {
|
||||
seasonal.features <- data.frame(row.names = seq_len(nrow(df)))
|
||||
prior.scales <- c()
|
||||
modes <- list(additive = c(), multiplicative = c())
|
||||
|
||||
# Seasonality features
|
||||
for (name in names(m$seasonalities)) {
|
||||
|
|
@ -681,6 +727,7 @@ make_all_seasonality_features <- function(m, df) {
|
|||
seasonal.features <- cbind(seasonal.features, features)
|
||||
prior.scales <- c(prior.scales,
|
||||
props$prior.scale * rep(1, ncol(features)))
|
||||
modes[[props$mode]] <- c(modes[[props$mode]], name)
|
||||
}
|
||||
|
||||
# Holiday features
|
||||
|
|
@ -688,20 +735,129 @@ make_all_seasonality_features <- function(m, df) {
|
|||
hf <- make_holiday_features(m, df$ds)
|
||||
seasonal.features <- cbind(seasonal.features, hf$holiday.features)
|
||||
prior.scales <- c(prior.scales, hf$prior.scales)
|
||||
modes[[m$seasonality.mode]] <- c(
|
||||
modes[[m$seasonality.mode]], hf$holiday.names)
|
||||
}
|
||||
|
||||
# Additional regressors
|
||||
for (name in names(m$extra_regressors)) {
|
||||
props <- m$extra_regressors[[name]]
|
||||
seasonal.features[[name]] <- df[[name]]
|
||||
prior.scales <- c(prior.scales, m$extra_regressors[[name]]$prior.scale)
|
||||
prior.scales <- c(prior.scales, props$prior.scale)
|
||||
modes[[props$mode]] <- c(modes[[props$mode]], name)
|
||||
}
|
||||
|
||||
# Dummy to prevent empty X
|
||||
if (ncol(seasonal.features) == 0) {
|
||||
seasonal.features <- data.frame(zeros = rep(0, nrow(df)))
|
||||
prior.scales <- 1
|
||||
}
|
||||
|
||||
components.list <- regressor_column_matrix(m, seasonal.features, modes)
|
||||
return(list(seasonal.features = seasonal.features,
|
||||
prior.scales = prior.scales))
|
||||
prior.scales = prior.scales,
|
||||
component.cols = components.list$component.cols,
|
||||
modes = components.list$modes))
|
||||
}
|
||||
|
||||
#' Dataframe indicating which columns of the feature matrix correspond to
|
||||
#' which seasonality/regressor components.
|
||||
#'
|
||||
#' Includes combination components, like 'additive_terms'. These combination
|
||||
#' components will be added to the 'modes' input.
|
||||
#'
|
||||
#' @param m Prophet object.
|
||||
#' @param seasonal.features Constructed seasonal features dataframe.
|
||||
#' @param modes List with keys 'additive' and 'multiplicative' with arrays of
|
||||
#' component names for each mode of seasonality.
|
||||
#'
|
||||
#' @return List with items
|
||||
#' component.cols: A binary indicator dataframe with columns seasonal
|
||||
#' components and rows columns in seasonal.features. Entry is 1 if that
|
||||
#' column is used in that component.
|
||||
#' modes: Updated input with combination components.
|
||||
#'
|
||||
#' @keywords internal
|
||||
regressor_column_matrix <- function(m, seasonal.features, modes) {
|
||||
components <- dplyr::data_frame(component = colnames(seasonal.features)) %>%
|
||||
dplyr::mutate(col = seq_len(n())) %>%
|
||||
tidyr::separate(component, c('component', 'part'), sep = "_delim_",
|
||||
extra = "merge", fill = "right") %>%
|
||||
dplyr::select(col, component)
|
||||
# Add total for holidays
|
||||
if(!is.null(m$holidays)){
|
||||
components <- add_group_component(
|
||||
components, 'holidays', unique(m$holidays$holiday))
|
||||
}
|
||||
# Add totals for additive and multiplicative components, and regressors
|
||||
for (mode in c('additive', 'multiplicative')) {
|
||||
components <- add_group_component(
|
||||
components, paste0(mode, '_terms'), modes[[mode]])
|
||||
regressors_by_mode <- c()
|
||||
for (name in names(m$extra_regressors)) {
|
||||
if (m$extra_regressors[[name]]$mode == mode) {
|
||||
regressors_by_mode <- c(regressors_by_mode, name)
|
||||
}
|
||||
}
|
||||
components <- add_group_component(
|
||||
components, paste0('extra_regressors_', mode), regressors_by_mode)
|
||||
# Add combination components to modes
|
||||
modes[[mode]] <- c(modes[[mode]], paste0(mode, '_terms'))
|
||||
modes[[mode]] <- c(modes[[mode]], paste0('extra_regressors_', mode))
|
||||
}
|
||||
# After all of the additive/multiplicative groups have been added,
|
||||
modes[[m$seasonality.mode]] <- c(modes[[m$seasonality.mode]], 'holidays')
|
||||
# Convert to a binary matrix
|
||||
component.cols <- as.data.frame.matrix(
|
||||
table(components$col, components$component)
|
||||
)
|
||||
component.cols <- (
|
||||
component.cols[order(as.numeric(row.names(component.cols))), ,
|
||||
drop = FALSE]
|
||||
)
|
||||
# Add columns for additive and multiplicative terms, if missing
|
||||
for (name in c('additive_terms', 'multiplicative_terms')) {
|
||||
if (!(name %in% colnames(component.cols))) {
|
||||
component.cols[[name]] <- 0
|
||||
}
|
||||
}
|
||||
# Remove the placeholder
|
||||
components <- dplyr::filter(components, component != 'zeros')
|
||||
# Validation
|
||||
if (
|
||||
max(component.cols$additive_terms
|
||||
+ component.cols$multiplicative_terms) > 1
|
||||
) {
|
||||
stop('A bug occurred in seasonal components.')
|
||||
}
|
||||
# Compare to training, if set.
|
||||
if (!is.null(m$train.component.cols)) {
|
||||
component.cols <- component.cols[, colnames(m$train.component.cols)]
|
||||
if (!all(component.cols == m$train.component.cols)) {
|
||||
stop('A bug occurred in constructing regressors.')
|
||||
}
|
||||
}
|
||||
return(list(component.cols = component.cols, modes = modes))
|
||||
}
|
||||
|
||||
#' Adds a component with given name that contains all of the components
|
||||
#' in group.
|
||||
#'
|
||||
#' @param components Dataframe with components.
|
||||
#' @param name Name of new group component.
|
||||
#' @param group List of components that form the group.
|
||||
#'
|
||||
#' @return Dataframe with components.
|
||||
#'
|
||||
#' @keywords internal
|
||||
add_group_component <- function(components, name, group) {
|
||||
new_comp <- components[(components$component %in% group), ]
|
||||
group_cols <- unique(new_comp$col)
|
||||
if (length(group_cols) > 0) {
|
||||
new_comp <- data.frame(col=group_cols, component=name)
|
||||
components <- rbind(components, new_comp)
|
||||
}
|
||||
return(components)
|
||||
}
|
||||
|
||||
#' Get number of Fourier components for built-in seasonalities.
|
||||
|
|
@ -764,7 +920,8 @@ set_auto_seasonalities <- function(m) {
|
|||
m$seasonalities[['yearly']] <- list(
|
||||
period = 365.25,
|
||||
fourier.order = fourier.order,
|
||||
prior.scale = m$seasonality.prior.scale
|
||||
prior.scale = m$seasonality.prior.scale,
|
||||
mode = m$seasonality.mode
|
||||
)
|
||||
}
|
||||
|
||||
|
|
@ -775,7 +932,8 @@ set_auto_seasonalities <- function(m) {
|
|||
m$seasonalities[['weekly']] <- list(
|
||||
period = 7,
|
||||
fourier.order = fourier.order,
|
||||
prior.scale = m$seasonality.prior.scale
|
||||
prior.scale = m$seasonality.prior.scale,
|
||||
mode = m$seasonality.mode
|
||||
)
|
||||
}
|
||||
|
||||
|
|
@ -786,7 +944,8 @@ set_auto_seasonalities <- function(m) {
|
|||
m$seasonalities[['daily']] <- list(
|
||||
period = 1,
|
||||
fourier.order = fourier.order,
|
||||
prior.scale = m$seasonality.prior.scale
|
||||
prior.scale = m$seasonality.prior.scale,
|
||||
mode = m$seasonality.mode
|
||||
)
|
||||
}
|
||||
return(m)
|
||||
|
|
@ -891,6 +1050,9 @@ fit.prophet <- function(m, df, ...) {
|
|||
out2 <- make_all_seasonality_features(m, history)
|
||||
seasonal.features <- out2$seasonal.features
|
||||
prior.scales <- out2$prior.scales
|
||||
component.cols <- out2$component.cols
|
||||
m$train.component.cols <- component.cols
|
||||
m$component.modes <- out2$modes
|
||||
|
||||
m <- set_changepoints(m)
|
||||
|
||||
|
|
@ -905,7 +1067,9 @@ fit.prophet <- function(m, df, ...) {
|
|||
X = as.matrix(seasonal.features),
|
||||
sigmas = array(prior.scales),
|
||||
tau = m$changepoint.prior.scale,
|
||||
trend_indicator = as.numeric(m$growth == 'logistic')
|
||||
trend_indicator = as.numeric(m$growth == 'logistic'),
|
||||
s_a = array(component.cols$additive_terms),
|
||||
s_m = array(component.cols$multiplicative_terms)
|
||||
)
|
||||
|
||||
# Run stan
|
||||
|
|
@ -1023,7 +1187,7 @@ predict.prophet <- function(object, df = NULL, ...) {
|
|||
}
|
||||
df <- df[cols]
|
||||
df <- dplyr::bind_cols(df, seasonal.components, intervals)
|
||||
df$yhat <- df$trend + df$seasonal
|
||||
df$yhat <- df$trend * (1 + df$multiplicative_terms) + df$additive_terms
|
||||
return(df)
|
||||
}
|
||||
|
||||
|
|
@ -1118,76 +1282,37 @@ predict_trend <- function(model, df) {
|
|||
#'
|
||||
#' @keywords internal
|
||||
predict_seasonal_components <- function(m, df) {
|
||||
seasonal.features <- make_all_seasonality_features(m, df)$seasonal.features
|
||||
out <- make_all_seasonality_features(m, df)
|
||||
seasonal.features <- out$seasonal.features
|
||||
component.cols <- out$component.cols
|
||||
lower.p <- (1 - m$interval.width)/2
|
||||
upper.p <- (1 + m$interval.width)/2
|
||||
|
||||
components <- dplyr::data_frame(component = colnames(seasonal.features)) %>%
|
||||
dplyr::mutate(col = seq_len(n())) %>%
|
||||
tidyr::separate(component, c('component', 'part'), sep = "_delim_",
|
||||
extra = "merge", fill = "right") %>%
|
||||
dplyr::select(col, component)
|
||||
# Add total for all regression components
|
||||
components <- rbind(
|
||||
components,
|
||||
data.frame(col = seq_len(ncol(seasonal.features)), component = 'seasonal'))
|
||||
# Add totals for seasonality, holiday, and extra regressors
|
||||
components <- add_group_component(
|
||||
components, 'seasonalities', names(m$seasonalities))
|
||||
if(!is.null(m$holidays)){
|
||||
components <- add_group_component(
|
||||
components, 'holidays', unique(m$holidays$holiday))
|
||||
X <- as.matrix(seasonal.features)
|
||||
component.predictions <- data.frame(matrix(ncol = 0, nrow = nrow(X)))
|
||||
for (component in colnames(component.cols)) {
|
||||
beta.c <- m$params$beta * component.cols[[component]]
|
||||
|
||||
comp <- X %*% t(beta.c)
|
||||
if (component %in% m$component.modes$additive) {
|
||||
comp <- comp * m$y.scale
|
||||
}
|
||||
component.predictions[[component]] <- rowMeans(comp, na.rm = TRUE)
|
||||
component.predictions[[paste0(component, '_lower')]] <- apply(
|
||||
comp, 1, stats::quantile, lower.p, na.rm = TRUE)
|
||||
component.predictions[[paste0(component, '_upper')]] <- apply(
|
||||
comp, 1, stats::quantile, upper.p, na.rm = TRUE)
|
||||
}
|
||||
components <- add_group_component(
|
||||
components, 'extra_regressors', names(m$extra_regressors))
|
||||
# Remove the placeholder
|
||||
components <- dplyr::filter(components, component != 'zeros')
|
||||
|
||||
component.predictions <- components %>%
|
||||
dplyr::group_by(component) %>% dplyr::do({
|
||||
comp <- (as.matrix(seasonal.features[, .$col])
|
||||
%*% t(m$params$beta[, .$col, drop = FALSE])) * m$y.scale
|
||||
dplyr::data_frame(ix = seq_len(nrow(seasonal.features)),
|
||||
mean = rowMeans(comp, na.rm = TRUE),
|
||||
lower = apply(comp, 1, stats::quantile, lower.p,
|
||||
na.rm = TRUE),
|
||||
upper = apply(comp, 1, stats::quantile, upper.p,
|
||||
na.rm = TRUE))
|
||||
}) %>%
|
||||
tidyr::gather(stat, value, mean, lower, upper) %>%
|
||||
dplyr::mutate(stat = ifelse(stat == 'mean', '', paste0('_', stat))) %>%
|
||||
tidyr::unite(component, component, stat, sep="") %>%
|
||||
tidyr::spread(component, value) %>%
|
||||
dplyr::select(-ix)
|
||||
|
||||
return(component.predictions)
|
||||
}
|
||||
|
||||
#' Adds a component with given name that contains all of the components
|
||||
#' in group.
|
||||
#'
|
||||
#' @param components Dataframe with components.
|
||||
#' @param name Name of new group component.
|
||||
#' @param group List of components that form the group.
|
||||
#'
|
||||
#' @return Dataframe with components.
|
||||
#'
|
||||
#' @keywords internal
|
||||
add_group_component <- function(components, name, group) {
|
||||
new_comp <- components[(components$component %in% group), ]
|
||||
if (nrow(new_comp) > 0) {
|
||||
new_comp$component <- name
|
||||
components <- rbind(components, new_comp)
|
||||
}
|
||||
return(components)
|
||||
}
|
||||
|
||||
#' Prophet posterior predictive samples.
|
||||
#'
|
||||
#' @param m Prophet object.
|
||||
#' @param df Prediction dataframe.
|
||||
#'
|
||||
#' @return List with posterior predictive samples for each component.
|
||||
#' @return List with posterior predictive samples for the forecast yhat and
|
||||
#' for the trend component.
|
||||
#'
|
||||
#' @keywords internal
|
||||
sample_posterior_predictive <- function(m, df) {
|
||||
|
|
@ -1196,16 +1321,24 @@ sample_posterior_predictive <- function(m, df) {
|
|||
samp.per.iter <- max(1, ceiling(m$uncertainty.samples / n.iterations))
|
||||
nsamp <- n.iterations * samp.per.iter # The actual number of samples
|
||||
|
||||
seasonal.features <- make_all_seasonality_features(m, df)$seasonal.features
|
||||
out <- make_all_seasonality_features(m, df)
|
||||
seasonal.features <- out$seasonal.features
|
||||
component.cols <- out$component.cols
|
||||
sim.values <- list("trend" = matrix(, nrow = nrow(df), ncol = nsamp),
|
||||
"seasonal" = matrix(, nrow = nrow(df), ncol = nsamp),
|
||||
"yhat" = matrix(, nrow = nrow(df), ncol = nsamp))
|
||||
|
||||
for (i in seq_len(n.iterations)) {
|
||||
# For each set of parameters from MCMC (or just 1 set for MAP),
|
||||
for (j in seq_len(samp.per.iter)) {
|
||||
# Do a simulation with this set of parameters,
|
||||
sim <- sample_model(m, df, seasonal.features, i)
|
||||
sim <- sample_model(
|
||||
m = m,
|
||||
df = df,
|
||||
seasonal.features = seasonal.features,
|
||||
iteration = i,
|
||||
s_a = component.cols$additive_terms,
|
||||
s_m = component.cols$multiplicative_terms
|
||||
)
|
||||
# Store the results
|
||||
for (key in c("trend", "seasonal", "yhat")) {
|
||||
sim.values[[key]][,(i - 1) * samp.per.iter + j] <- sim[[key]]
|
||||
|
|
@ -1221,9 +1354,8 @@ sample_posterior_predictive <- function(m, df) {
|
|||
#' @param df Dataframe with dates for predictions (column ds), and capacity
|
||||
#' (column cap) if logistic growth.
|
||||
#'
|
||||
#' @return A list with items "trend", "seasonal", and "yhat" containing
|
||||
#' posterior predictive samples for that component. "seasonal" is the sum
|
||||
#' of seasonalities, holidays, and added regressors.
|
||||
#' @return A list with items "trend" and "yhat" containing
|
||||
#' posterior predictive samples for that component.
|
||||
#'
|
||||
#' @export
|
||||
predictive_samples <- function(m, df) {
|
||||
|
|
@ -1264,22 +1396,24 @@ predict_uncertainty <- function(m, df) {
|
|||
#' @param df Prediction dataframe.
|
||||
#' @param seasonal.features Data frame of seasonal features
|
||||
#' @param iteration Int sampling iteration to use parameters from.
|
||||
#' @param s_a Indicator vector for additive components
|
||||
#' @param s_m Indicator vector for multiplicative components
|
||||
#'
|
||||
#' @return List of trend, seasonality, and yhat, each a vector like df$t.
|
||||
#' @return List of trend and yhat, each a vector like df$t.
|
||||
#'
|
||||
#' @keywords internal
|
||||
sample_model <- function(m, df, seasonal.features, iteration) {
|
||||
sample_model <- function(m, df, seasonal.features, iteration, s_a, s_m) {
|
||||
trend <- sample_predictive_trend(m, df, iteration)
|
||||
|
||||
beta <- m$params$beta[iteration,]
|
||||
seasonal <- (as.matrix(seasonal.features) %*% beta) * m$y.scale
|
||||
Xb_a = as.matrix(seasonal.features) %*% (beta * s_a) * m$y.scale
|
||||
Xb_m = as.matrix(seasonal.features) %*% (beta * s_m)
|
||||
|
||||
sigma <- m$params$sigma_obs[iteration]
|
||||
noise <- stats::rnorm(nrow(df), mean = 0, sd = sigma) * m$y.scale
|
||||
|
||||
return(list("yhat" = trend + seasonal + noise,
|
||||
"trend" = trend,
|
||||
"seasonal" = seasonal))
|
||||
return(list("yhat" = trend * (1 + Xb_m) + Xb_a + noise,
|
||||
"trend" = trend))
|
||||
}
|
||||
|
||||
#' Simulate the trend using the extrapolated generative model.
|
||||
|
|
|
|||
|
|
@ -85,6 +85,8 @@ data {
|
|||
vector[K] sigmas; // Scale on seasonality prior
|
||||
real<lower=0> tau; // Scale on changepoints prior
|
||||
int trend_indicator; // 0 for linear, 1 for logistic
|
||||
vector[K] s_a; // Indicator of additive features
|
||||
vector[K] s_m; // Indicator of multiplicative features
|
||||
}
|
||||
|
||||
transformed data {
|
||||
|
|
@ -102,12 +104,17 @@ parameters {
|
|||
|
||||
transformed parameters {
|
||||
vector[T] trend;
|
||||
vector[T] Xb_a;
|
||||
vector[T] Xb_m;
|
||||
|
||||
if (trend_indicator == 0) {
|
||||
trend = linear_trend(k, m, delta, t, A, t_change);
|
||||
} else if (trend_indicator == 1) {
|
||||
trend = logistic_trend(k, m, delta, t, cap, A, t_change, S);
|
||||
}
|
||||
|
||||
Xb_a = X * (beta .* s_a);
|
||||
Xb_m = X * (beta .* s_m);
|
||||
}
|
||||
|
||||
model {
|
||||
|
|
@ -119,5 +126,5 @@ model {
|
|||
beta ~ normal(0, sigmas);
|
||||
|
||||
// Likelihood
|
||||
y ~ normal(trend + X * beta, sigma_obs);
|
||||
y ~ normal(trend .* (1 + Xb_m) + Xb_a, sigma_obs);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@
|
|||
\alias{add_regressor}
|
||||
\title{Add an additional regressor to be used for fitting and predicting.}
|
||||
\usage{
|
||||
add_regressor(m, name, prior.scale = NULL, standardize = "auto")
|
||||
add_regressor(m, name, prior.scale = NULL, standardize = "auto",
|
||||
mode = NULL)
|
||||
}
|
||||
\arguments{
|
||||
\item{m}{Prophet object.}
|
||||
|
|
@ -17,6 +18,9 @@ holidays.prior.scale will be used.}
|
|||
\item{standardize}{Bool, specify whether this regressor will be standardized
|
||||
prior to fitting. Can be 'auto' (standardize if not binary), True, or
|
||||
False.}
|
||||
|
||||
\item{mode}{Optional, 'additive' or 'multiplicative'. Defaults to
|
||||
m$seasonality.mode.}
|
||||
}
|
||||
\value{
|
||||
The prophet model with the regressor added.
|
||||
|
|
@ -28,4 +32,8 @@ regressor will be standardized unless it is binary. The regression
|
|||
coefficient is given a prior with the specified scale parameter.
|
||||
Decreasing the prior scale will add additional regularization. If no
|
||||
prior scale is provided, holidays.prior.scale will be used.
|
||||
Mode can be specified as either 'additive' or 'multiplicative'. If not
|
||||
specified, m$seasonality.mode will be used. 'additive' means the effect of
|
||||
the regressor will be added to the trend, 'multiplicative' means it will
|
||||
multiply the trend.
|
||||
}
|
||||
|
|
|
|||
|
|
@ -5,7 +5,8 @@
|
|||
\title{Add a seasonal component with specified period, number of Fourier
|
||||
components, and prior scale.}
|
||||
\usage{
|
||||
add_seasonality(m, name, period, fourier.order, prior.scale = NULL)
|
||||
add_seasonality(m, name, period, fourier.order, prior.scale = NULL,
|
||||
mode = NULL)
|
||||
}
|
||||
\arguments{
|
||||
\item{m}{Prophet object.}
|
||||
|
|
@ -16,7 +17,9 @@ add_seasonality(m, name, period, fourier.order, prior.scale = NULL)
|
|||
|
||||
\item{fourier.order}{Int number of Fourier components to use.}
|
||||
|
||||
\item{prior.scale}{Float prior scale for this component.}
|
||||
\item{prior.scale}{Optional float prior scale for this component.}
|
||||
|
||||
\item{mode}{Optional 'additive' or 'multiplicative'.}
|
||||
}
|
||||
\value{
|
||||
The prophet model with the seasonality added.
|
||||
|
|
@ -30,4 +33,9 @@ seasonalities are 10 and 3 respectively.
|
|||
Increasing prior scale will allow this seasonality component more
|
||||
flexibility, decreasing will dampen it. If not provided, will use the
|
||||
seasonality.prior.scale provided on Prophet initialization (defaults to 10).
|
||||
|
||||
Mode can be specified as either 'additive' or 'multiplicative'. If not
|
||||
specified, m$seasonality.mode will be used (defaults to 'additive').
|
||||
Additive means the seasonality will be added to the trend, multiplicative
|
||||
means it will multiply the trend.
|
||||
}
|
||||
|
|
|
|||
|
|
@ -18,6 +18,10 @@ List with items
|
|||
seasonal.features: Dataframe with regressor features,
|
||||
prior.scales: Array of prior scales for each colum of the features
|
||||
dataframe.
|
||||
component.cols: Dataframe with indicators for which regression components
|
||||
correspond to which columns.
|
||||
modes: List with keys 'additive' and 'multiplicative' with arrays of
|
||||
component names for each mode of seasonality.
|
||||
}
|
||||
\description{
|
||||
Dataframe with seasonality features.
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@ make_holiday_features(m, dates)
|
|||
A list with entries
|
||||
holiday.features: dataframe with a column for each holiday.
|
||||
prior.scales: array of prior scales for each holiday column.
|
||||
holiday.names: array of names of all holidays.
|
||||
}
|
||||
\description{
|
||||
Construct a matrix of holiday features.
|
||||
|
|
|
|||
|
|
@ -4,9 +4,11 @@
|
|||
\alias{plot_forecast_component}
|
||||
\title{Plot a particular component of the forecast.}
|
||||
\usage{
|
||||
plot_forecast_component(fcst, name, uncertainty = TRUE, plot_cap = FALSE)
|
||||
plot_forecast_component(m, fcst, name, uncertainty = TRUE, plot_cap = FALSE)
|
||||
}
|
||||
\arguments{
|
||||
\item{m}{Prophet model}
|
||||
|
||||
\item{fcst}{Dataframe output of `predict`.}
|
||||
|
||||
\item{name}{String name of the component to plot (column of fcst).}
|
||||
|
|
|
|||
|
|
@ -13,9 +13,8 @@ predictive_samples(m, df)
|
|||
(column cap) if logistic growth.}
|
||||
}
|
||||
\value{
|
||||
A list with items "trend", "seasonal", and "yhat" containing
|
||||
posterior predictive samples for that component. "seasonal" is the sum
|
||||
of seasonalities, holidays, and added regressors.
|
||||
A list with items "trend" and "yhat" containing
|
||||
posterior predictive samples for that component.
|
||||
}
|
||||
\description{
|
||||
Sample from the posterior predictive distribution.
|
||||
|
|
|
|||
|
|
@ -7,10 +7,10 @@
|
|||
prophet(df = NULL, growth = "linear", changepoints = NULL,
|
||||
n.changepoints = 25, yearly.seasonality = "auto",
|
||||
weekly.seasonality = "auto", daily.seasonality = "auto",
|
||||
holidays = NULL, seasonality.prior.scale = 10,
|
||||
holidays.prior.scale = 10, changepoint.prior.scale = 0.05,
|
||||
mcmc.samples = 0, interval.width = 0.8, uncertainty.samples = 1000,
|
||||
fit = TRUE, ...)
|
||||
holidays = NULL, seasonality.mode = "additive",
|
||||
seasonality.prior.scale = 10, holidays.prior.scale = 10,
|
||||
changepoint.prior.scale = 0.05, mcmc.samples = 0, interval.width = 0.8,
|
||||
uncertainty.samples = 1000, fit = TRUE, ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{df}{(optional) Dataframe containing the history. Must have columns ds
|
||||
|
|
@ -46,6 +46,8 @@ range of days around the date to be included as holidays. lower_window=-2
|
|||
will include 2 days prior to the date as holidays. Also optionally can have
|
||||
a column prior_scale specifying the prior scale for each holiday.}
|
||||
|
||||
\item{seasonality.mode}{'additive' (default) or 'multiplicative'.}
|
||||
|
||||
\item{seasonality.prior.scale}{Parameter modulating the strength of the
|
||||
seasonality model. Larger values allow the model to fit larger seasonal
|
||||
fluctuations, smaller values dampen the seasonality. Can be specified for
|
||||
|
|
|
|||
|
|
@ -3,8 +3,9 @@
|
|||
\name{prophet_plot_components}
|
||||
\alias{prophet_plot_components}
|
||||
\title{Plot the components of a prophet forecast.
|
||||
Prints a ggplot2 with panels for trend, weekly and yearly seasonalities if
|
||||
present, and holidays if present.}
|
||||
Prints a ggplot2 with whichever are available of: trend, holidays, weekly
|
||||
seasonality, yearly seasonality, and additive and multiplicative extra
|
||||
regressors.}
|
||||
\usage{
|
||||
prophet_plot_components(m, fcst, uncertainty = TRUE, plot_cap = TRUE,
|
||||
weekly_start = 0, yearly_start = 0)
|
||||
|
|
@ -33,6 +34,7 @@ Invisibly return a list containing the plotted ggplot objects
|
|||
}
|
||||
\description{
|
||||
Plot the components of a prophet forecast.
|
||||
Prints a ggplot2 with panels for trend, weekly and yearly seasonalities if
|
||||
present, and holidays if present.
|
||||
Prints a ggplot2 with whichever are available of: trend, holidays, weekly
|
||||
seasonality, yearly seasonality, and additive and multiplicative extra
|
||||
regressors.
|
||||
}
|
||||
|
|
|
|||
29
R/man/regressor_column_matrix.Rd
Normal file
29
R/man/regressor_column_matrix.Rd
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/prophet.R
|
||||
\name{regressor_column_matrix}
|
||||
\alias{regressor_column_matrix}
|
||||
\title{Dataframe indicating which columns of the feature matrix correspond to
|
||||
which seasonality/regressor components.}
|
||||
\usage{
|
||||
regressor_column_matrix(m, seasonal.features, modes)
|
||||
}
|
||||
\arguments{
|
||||
\item{m}{Prophet object.}
|
||||
|
||||
\item{seasonal.features}{Constructed seasonal features dataframe.}
|
||||
|
||||
\item{modes}{List with keys 'additive' and 'multiplicative' with arrays of
|
||||
component names for each mode of seasonality.}
|
||||
}
|
||||
\value{
|
||||
List with items
|
||||
component.cols: A binary indicator dataframe with columns seasonal
|
||||
components and rows columns in seasonal.features. Entry is 1 if that
|
||||
column is used in that component.
|
||||
modes: Updated input with combination components.
|
||||
}
|
||||
\description{
|
||||
Includes combination components, like 'additive_terms'. These combination
|
||||
components will be added to the 'modes' input.
|
||||
}
|
||||
\keyword{internal}
|
||||
|
|
@ -4,7 +4,7 @@
|
|||
\alias{sample_model}
|
||||
\title{Simulate observations from the extrapolated generative model.}
|
||||
\usage{
|
||||
sample_model(m, df, seasonal.features, iteration)
|
||||
sample_model(m, df, seasonal.features, iteration, s_a, s_m)
|
||||
}
|
||||
\arguments{
|
||||
\item{m}{Prophet object.}
|
||||
|
|
@ -14,9 +14,13 @@ sample_model(m, df, seasonal.features, iteration)
|
|||
\item{seasonal.features}{Data frame of seasonal features}
|
||||
|
||||
\item{iteration}{Int sampling iteration to use parameters from.}
|
||||
|
||||
\item{s_a}{Indicator vector for additive components}
|
||||
|
||||
\item{s_m}{Indicator vector for multiplicative components}
|
||||
}
|
||||
\value{
|
||||
List of trend, seasonality, and yhat, each a vector like df$t.
|
||||
List of trend and yhat, each a vector like df$t.
|
||||
}
|
||||
\description{
|
||||
Simulate observations from the extrapolated generative model.
|
||||
|
|
|
|||
|
|
@ -12,7 +12,8 @@ sample_posterior_predictive(m, df)
|
|||
\item{df}{Prediction dataframe.}
|
||||
}
|
||||
\value{
|
||||
List with posterior predictive samples for each component.
|
||||
List with posterior predictive samples for the forecast yhat and
|
||||
for the trend component.
|
||||
}
|
||||
\description{
|
||||
Prophet posterior predictive samples.
|
||||
|
|
|
|||
|
|
@ -144,7 +144,8 @@ test_that("copy", {
|
|||
yearly.seasonality = c(TRUE, FALSE),
|
||||
weekly.seasonality = c(TRUE, FALSE),
|
||||
daily.seasonality = c(TRUE, FALSE),
|
||||
holidays = c('null', 'insert_dataframe')
|
||||
holidays = c('null', 'insert_dataframe'),
|
||||
seasonality.mode = c('additive', 'multiplicative')
|
||||
)
|
||||
products <- expand.grid(inputs)
|
||||
for (i in 1:length(products)) {
|
||||
|
|
@ -178,7 +179,7 @@ test_that("copy", {
|
|||
args <- c('growth', 'changepoints', 'n.changepoints', 'holidays',
|
||||
'seasonality.prior.scale', 'holidays.prior.scale',
|
||||
'changepoints.prior.scale', 'mcmc.samples', 'interval.width',
|
||||
'uncertainty.samples')
|
||||
'uncertainty.samples', 'seasonality.mode')
|
||||
for (arg in args) {
|
||||
expect_equal(m1[[arg]], m2[[arg]])
|
||||
}
|
||||
|
|
|
|||
|
|
@ -225,7 +225,7 @@ test_that("piecewise_logistic", {
|
|||
})
|
||||
|
||||
test_that("holidays", {
|
||||
holidays = data.frame(ds = c('2016-12-25'),
|
||||
holidays <- data.frame(ds = c('2016-12-25'),
|
||||
holiday = c('xmas'),
|
||||
lower_window = c(-1),
|
||||
upper_window = c(0))
|
||||
|
|
@ -236,12 +236,14 @@ test_that("holidays", {
|
|||
out <- prophet:::make_holiday_features(m, df$ds)
|
||||
feats <- out$holiday.features
|
||||
priors <- out$prior.scales
|
||||
names <- out$holiday.names
|
||||
expect_equal(nrow(feats), nrow(df))
|
||||
expect_equal(ncol(feats), 2)
|
||||
expect_equal(sum(colSums(feats) - c(1, 1)), 0)
|
||||
expect_true(all(priors == c(10., 10.)))
|
||||
expect_equal(names, c('xmas'))
|
||||
|
||||
holidays = data.frame(ds = c('2016-12-25'),
|
||||
holidays <- data.frame(ds = c('2016-12-25'),
|
||||
holiday = c('xmas'),
|
||||
lower_window = c(-1),
|
||||
upper_window = c(10))
|
||||
|
|
@ -249,9 +251,11 @@ test_that("holidays", {
|
|||
out <- prophet:::make_holiday_features(m, df$ds)
|
||||
feats <- out$holiday.features
|
||||
priors <- out$prior.scales
|
||||
names <- out$holiday.names
|
||||
expect_equal(nrow(feats), nrow(df))
|
||||
expect_equal(ncol(feats), 12)
|
||||
expect_true(all(priors == rep(10, 12)))
|
||||
expect_equal(names, c('xmas'))
|
||||
# Check prior specifications
|
||||
holidays <- data.frame(
|
||||
ds = prophet:::set_date(c('2016-12-25', '2017-12-25')),
|
||||
|
|
@ -263,7 +267,9 @@ test_that("holidays", {
|
|||
m <- prophet(holidays = holidays, fit = FALSE)
|
||||
out <- prophet:::make_holiday_features(m, df$ds)
|
||||
priors <- out$prior.scales
|
||||
names <- out$holiday.names
|
||||
expect_true(all(priors == c(5., 5.)))
|
||||
expect_equal(names, c('xmas'))
|
||||
# 2 different priors
|
||||
holidays2 <- data.frame(
|
||||
ds = prophet:::set_date(c('2012-06-06', '2013-06-06')),
|
||||
|
|
@ -276,7 +282,9 @@ test_that("holidays", {
|
|||
m <- prophet(holidays = holidays2, fit = FALSE)
|
||||
out <- prophet:::make_holiday_features(m, df$ds)
|
||||
priors <- out$prior.scales
|
||||
names <- out$holiday.names
|
||||
expect_true(all(priors == c(8, 8, 5, 5)))
|
||||
expect_true(all(sort(names) == c('seans-bday', 'xmas')))
|
||||
holidays2 <- data.frame(
|
||||
ds = prophet:::set_date(c('2012-06-06', '2013-06-06')),
|
||||
holiday = c('seans-bday', 'seans-bday'),
|
||||
|
|
@ -334,7 +342,8 @@ test_that("auto_weekly_seasonality", {
|
|||
expect_equal(m$weekly.seasonality, 'auto')
|
||||
m <- fit.prophet(m, train.w)
|
||||
expect_true('weekly' %in% names(m$seasonalities))
|
||||
true <- list(period = 7, fourier.order = 3, prior.scale = 10)
|
||||
true <- list(
|
||||
period = 7, fourier.order = 3, prior.scale = 10, mode = 'additive')
|
||||
for (name in names(true)) {
|
||||
expect_equal(m$seasonalities$weekly[[name]], true[[name]])
|
||||
}
|
||||
|
|
@ -350,7 +359,8 @@ test_that("auto_weekly_seasonality", {
|
|||
m <- prophet(train.w)
|
||||
expect_false('weekly' %in% names(m$seasonalities))
|
||||
m <- prophet(DATA, weekly.seasonality = 2, seasonality.prior.scale = 3)
|
||||
true <- list(period = 7, fourier.order = 2, prior.scale = 3)
|
||||
true <- list(
|
||||
period = 7, fourier.order = 2, prior.scale = 3, mode = 'additive')
|
||||
for (name in names(true)) {
|
||||
expect_equal(m$seasonalities$weekly[[name]], true[[name]])
|
||||
}
|
||||
|
|
@ -363,7 +373,8 @@ test_that("auto_yearly_seasonality", {
|
|||
expect_equal(m$yearly.seasonality, 'auto')
|
||||
m <- fit.prophet(m, DATA)
|
||||
expect_true('yearly' %in% names(m$seasonalities))
|
||||
true <- list(period = 365.25, fourier.order = 10, prior.scale = 10)
|
||||
true <- list(
|
||||
period = 365.25, fourier.order = 10, prior.scale = 10, mode = 'additive')
|
||||
for (name in names(true)) {
|
||||
expect_equal(m$seasonalities$yearly[[name]], true[[name]])
|
||||
}
|
||||
|
|
@ -375,7 +386,8 @@ test_that("auto_yearly_seasonality", {
|
|||
m <- prophet(train.y, yearly.seasonality = TRUE)
|
||||
expect_true('yearly' %in% names(m$seasonalities))
|
||||
m <- prophet(DATA, yearly.seasonality = 7, seasonality.prior.scale = 3)
|
||||
true <- list(period = 365.25, fourier.order = 7, prior.scale = 3)
|
||||
true <- list(
|
||||
period = 365.25, fourier.order = 7, prior.scale = 3, mode = 'additive')
|
||||
for (name in names(true)) {
|
||||
expect_equal(m$seasonalities$yearly[[name]], true[[name]])
|
||||
}
|
||||
|
|
@ -388,7 +400,8 @@ test_that("auto_daily_seasonality", {
|
|||
expect_equal(m$daily.seasonality, 'auto')
|
||||
m <- fit.prophet(m, DATA2)
|
||||
expect_true('daily' %in% names(m$seasonalities))
|
||||
true <- list(period = 1, fourier.order = 4, prior.scale = 10)
|
||||
true <- list(
|
||||
period = 1, fourier.order = 4, prior.scale = 10, mode = 'additive')
|
||||
for (name in names(true)) {
|
||||
expect_equal(m$seasonalities$daily[[name]], true[[name]])
|
||||
}
|
||||
|
|
@ -400,7 +413,8 @@ test_that("auto_daily_seasonality", {
|
|||
m <- prophet(train.y, daily.seasonality = TRUE)
|
||||
expect_true('daily' %in% names(m$seasonalities))
|
||||
m <- prophet(DATA2, daily.seasonality = 7, seasonality.prior.scale = 3)
|
||||
true <- list(period = 1, fourier.order = 7, prior.scale = 3)
|
||||
true <- list(
|
||||
period = 1, fourier.order = 7, prior.scale = 3, mode = 'additive')
|
||||
for (name in names(true)) {
|
||||
expect_equal(m$seasonalities$daily[[name]], true[[name]])
|
||||
}
|
||||
|
|
@ -424,7 +438,8 @@ test_that("custom_seasonality", {
|
|||
prior_scale = c(4))
|
||||
m <- prophet(holidays=holidays)
|
||||
m <- add_seasonality(m, name='monthly', period=30, fourier.order=5)
|
||||
true <- list(period = 30, fourier.order = 5, prior.scale = 10)
|
||||
true <- list(
|
||||
period = 30, fourier.order = 5, prior.scale = 10, mode = 'additive')
|
||||
for (name in names(true)) {
|
||||
expect_equal(m$seasonalities$monthly[[name]], true[[name]])
|
||||
}
|
||||
|
|
@ -436,12 +451,25 @@ test_that("custom_seasonality", {
|
|||
)
|
||||
m <- add_seasonality(m, name='weekly', period=30, fourier.order=5)
|
||||
# Test priors
|
||||
m <- prophet(holidays = holidays, yearly.seasonality = FALSE)
|
||||
m <- prophet(
|
||||
holidays = holidays, yearly.seasonality = FALSE,
|
||||
seasonality.mode = 'multiplicative')
|
||||
m <- add_seasonality(
|
||||
m, name='monthly', period=30, fourier.order=5, prior.scale = 2)
|
||||
m, name='monthly', period=30, fourier.order=5, prior.scale = 2,
|
||||
mode = 'additive')
|
||||
m <- fit.prophet(m, DATA)
|
||||
prior.scales <- prophet:::make_all_seasonality_features(
|
||||
m, m$history)$prior.scales
|
||||
expect_equal(m$seasonalities$monthly$mode, 'additive')
|
||||
expect_equal(m$seasonalities$weekly$mode, 'multiplicative')
|
||||
out <- prophet:::make_all_seasonality_features(m, m$history)
|
||||
prior.scales <- out$prior.scales
|
||||
component.cols <- out$component.cols
|
||||
expect_equal(sum(component.cols$monthly), 10)
|
||||
expect_equal(sum(component.cols$special_day), 1)
|
||||
expect_equal(sum(component.cols$weekly), 6)
|
||||
expect_equal(sum(component.cols$additive_terms), 10)
|
||||
expect_equal(sum(component.cols$multiplicative_terms), 7)
|
||||
expect_equal(sum(component.cols$monthly[1:11]), 10)
|
||||
expect_equal(sum(component.cols$weekly[11:17]), 6)
|
||||
expect_true(all(prior.scales == c(rep(2, 10), rep(10, 6), 4)))
|
||||
})
|
||||
|
||||
|
|
@ -450,10 +478,13 @@ test_that("added_regressors", {
|
|||
m <- prophet()
|
||||
m <- add_regressor(m, 'binary_feature', prior.scale=0.2)
|
||||
m <- add_regressor(m, 'numeric_feature', prior.scale=0.5)
|
||||
m <- add_regressor(
|
||||
m, 'numeric_feature2', prior.scale=0.5, mode = 'multiplicative')
|
||||
m <- add_regressor(m, 'binary_feature2', standardize=TRUE)
|
||||
df <- DATA
|
||||
df$binary_feature <- c(rep(0, 255), rep(1, 255))
|
||||
df$numeric_feature <- 0:509
|
||||
df$numeric_feature2 <- 0:509
|
||||
# Require all regressors in df
|
||||
expect_error(
|
||||
fit.prophet(m, df)
|
||||
|
|
@ -461,7 +492,9 @@ test_that("added_regressors", {
|
|||
df$binary_feature2 <- c(rep(1, 100), rep(0, 410))
|
||||
m <- fit.prophet(m, df)
|
||||
# Check that standardizations are correctly set
|
||||
true <- list(prior.scale = 0.2, mu = 0, std = 1, standardize = 'auto')
|
||||
true <- list(
|
||||
prior.scale = 0.2, mu = 0, std = 1, standardize = 'auto', mode = 'additive'
|
||||
)
|
||||
for (name in names(true)) {
|
||||
expect_equal(true[[name]], m$extra_regressors$binary_feature[[name]])
|
||||
}
|
||||
|
|
@ -470,6 +503,7 @@ test_that("added_regressors", {
|
|||
expect_equal(true[[name]], m$extra_regressors$numeric_feature[[name]],
|
||||
tolerance = 1e-5)
|
||||
}
|
||||
expect_equal(m$extra_regressors$numeric_feature2$mode, 'multiplicative')
|
||||
true <- list(prior.scale = 10., mu = 0.1960784, std = 0.3974183)
|
||||
for (name in names(true)) {
|
||||
expect_equal(true[[name]], m$extra_regressors$binary_feature2[[name]],
|
||||
|
|
@ -484,28 +518,91 @@ test_that("added_regressors", {
|
|||
out <- prophet:::make_all_seasonality_features(m, df2)
|
||||
seasonal.features <- out$seasonal.features
|
||||
prior.scales <- out$prior.scales
|
||||
expect_true('binary_feature' %in% colnames(seasonal.features))
|
||||
expect_true('numeric_feature' %in% colnames(seasonal.features))
|
||||
expect_true('binary_feature2' %in% colnames(seasonal.features))
|
||||
expect_equal(ncol(seasonal.features), 29)
|
||||
expect_true(all(sort(prior.scales[27:29]) == c(0.2, 0.5, 10.)))
|
||||
component.cols <- out$component.cols
|
||||
modes <- out$modes
|
||||
expect_equal(ncol(seasonal.features), 30)
|
||||
r_names <- c('binary_feature', 'numeric_feature', 'binary_feature2')
|
||||
true.priors <- c(0.2, 0.5, 10.)
|
||||
for (i in seq_along(r_names)) {
|
||||
name <- r_names[i]
|
||||
expect_true(name %in% colnames(seasonal.features))
|
||||
expect_equal(sum(component.cols[[name]]), 1)
|
||||
expect_equal(sum(prior.scales * component.cols[[name]]), true.priors[i])
|
||||
}
|
||||
# Check that forecast components are reasonable
|
||||
future <- data.frame(
|
||||
ds = c('2014-06-01'), binary_feature = c(0), numeric_feature = c(10))
|
||||
ds = c('2014-06-01'),
|
||||
binary_feature = c(0),
|
||||
numeric_feature = c(10),
|
||||
numeric_feature2 = c(10)
|
||||
)
|
||||
expect_error(predict(m, future))
|
||||
future$binary_feature2 <- 0.
|
||||
fcst <- predict(m, future)
|
||||
expect_equal(ncol(fcst), 31)
|
||||
expect_equal(ncol(fcst), 37)
|
||||
expect_equal(fcst$binary_feature[1], 0)
|
||||
expect_equal(fcst$extra_regressors[1],
|
||||
expect_equal(fcst$extra_regressors_additive[1],
|
||||
fcst$numeric_feature[1] + fcst$binary_feature2[1])
|
||||
expect_equal(fcst$seasonalities[1], fcst$yearly[1] + fcst$weekly[1])
|
||||
expect_equal(fcst$seasonal[1],
|
||||
fcst$seasonalities[1] + fcst$extra_regressors[1])
|
||||
expect_equal(fcst$yhat[1], fcst$trend[1] + fcst$seasonal[1])
|
||||
expect_equal(fcst$extra_regressors_multiplicative[1],
|
||||
fcst$numeric_feature2[1])
|
||||
expect_equal(fcst$additive_terms[1],
|
||||
fcst$yearly[1] + fcst$weekly[1]
|
||||
+ fcst$extra_regressors_additive[1])
|
||||
expect_equal(fcst$multiplicative_terms[1],
|
||||
fcst$extra_regressors_multiplicative[1])
|
||||
expect_equal(
|
||||
fcst$yhat[1],
|
||||
fcst$trend[1] * (1 + fcst$multiplicative_terms[1]) + fcst$additive_terms[1]
|
||||
)
|
||||
# Check fails if constant extra regressor
|
||||
df$constant_feature <- 5
|
||||
m <- prophet()
|
||||
m <- add_regressor(m, 'constant_feature')
|
||||
expect_error(fit.prophet(m, df))
|
||||
})
|
||||
|
||||
test_that("set_seasonality_mode", {
|
||||
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
||||
m <- prophet()
|
||||
expect_equal(m$seasonality.mode, 'additive')
|
||||
m <- prophet(seasonality.mode = 'multiplicative')
|
||||
expect_equal(m$seasonality.mode, 'multiplicative')
|
||||
expect_error(prophet(seasonality.mode = 'batman'))
|
||||
})
|
||||
|
||||
test_that("seasonality_modes", {
|
||||
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
||||
holidays <- data.frame(ds = c('2016-12-25'),
|
||||
holiday = c('xmas'),
|
||||
lower_window = c(-1),
|
||||
upper_window = c(0))
|
||||
m <- prophet(seasonality.mode = 'multiplicative', holidays = holidays)
|
||||
m <- add_seasonality(
|
||||
m, name = 'monthly', period = 30, fourier.order = 3, mode = 'additive')
|
||||
m <- add_regressor(m, name = 'binary_feature', mode = 'additive')
|
||||
m <- add_regressor(m, name = 'numeric_feature')
|
||||
# Construct seasonal features
|
||||
df <- DATA
|
||||
df$binary_feature <- c(rep(0, 255), rep(1, 255))
|
||||
df$numeric_feature <- 0:509
|
||||
out <- prophet:::setup_dataframe(m, df, initialize_scales = TRUE)
|
||||
df <- out$df
|
||||
m <- out$m
|
||||
m$history <- df
|
||||
m <- prophet:::set_auto_seasonalities(m)
|
||||
out <- prophet:::make_all_seasonality_features(m, df)
|
||||
component.cols <- out$component.cols
|
||||
modes <- out$modes
|
||||
expect_equal(sum(component.cols$additive_terms), 7)
|
||||
expect_equal(sum(component.cols$multiplicative_terms), 29)
|
||||
expect_equal(
|
||||
sort(modes$additive),
|
||||
c('additive_terms', 'binary_feature', 'extra_regressors_additive',
|
||||
'monthly')
|
||||
)
|
||||
expect_equal(
|
||||
sort(modes$multiplicative),
|
||||
c('extra_regressors_multiplicative', 'holidays', 'multiplicative_terms',
|
||||
'numeric_feature', 'weekly', 'xmas', 'yearly')
|
||||
)
|
||||
})
|
||||
|
|
|
|||
|
|
@ -1,9 +1,15 @@
|
|||
library(prophet)
|
||||
context("Prophet stan model tests")
|
||||
|
||||
rstan::expose_stan_functions(
|
||||
rstan::stanc(file="../..//inst/stan/prophet.stan")
|
||||
)
|
||||
fn <- tryCatch({
|
||||
rstan::expose_stan_functions(
|
||||
rstan::stanc(file="../../inst/stan/prophet.stan")
|
||||
)
|
||||
}, error = function(e) {
|
||||
rstan::expose_stan_functions(
|
||||
rstan::stanc(file=system.file("stan/prophet.stan", package="prophet"))
|
||||
)
|
||||
})
|
||||
|
||||
DATA <- read.csv('data.csv')
|
||||
N <- nrow(DATA)
|
||||
|
|
|
|||
|
|
@ -692,7 +692,7 @@ class Prophet(object):
|
|||
# Convert to a binary matrix
|
||||
component_cols = pd.crosstab(
|
||||
components['col'], components['component'],
|
||||
)
|
||||
).sort_index(level='col')
|
||||
# Add columns for additive and multiplicative terms, if missing
|
||||
for name in ['additive_terms', 'multiplicative_terms']:
|
||||
if name not in component_cols:
|
||||
|
|
@ -729,7 +729,7 @@ class Prophet(object):
|
|||
new_comp = components[components['component'].isin(set(group))].copy()
|
||||
group_cols = new_comp['col'].unique()
|
||||
if len(group_cols) > 0:
|
||||
new_comp = pd.DataFrame({'component': name, 'col': group_cols})
|
||||
new_comp = pd.DataFrame({'col': group_cols, 'component': name})
|
||||
components = components.append(new_comp)
|
||||
return components
|
||||
|
||||
|
|
@ -1248,6 +1248,8 @@ class Prophet(object):
|
|||
df: Prediction dataframe.
|
||||
seasonal_features: pd.DataFrame of seasonal features.
|
||||
iteration: Int sampling iteration to use parameters from.
|
||||
s_a: Indicator vector for additive components
|
||||
s_m: Indicator vector for multiplicative components
|
||||
|
||||
Returns
|
||||
-------
|
||||
|
|
|
|||
|
|
@ -344,7 +344,7 @@ def plot_seasonality(m, name, ax=None, uncertainty=True):
|
|||
ax.xaxis.set_major_formatter(FuncFormatter(
|
||||
lambda x, pos=None: fmt_str.format(dt=num2date(x))))
|
||||
ax.set_xlabel('ds')
|
||||
ax.set_ylabel('{}'.format(name))
|
||||
ax.set_ylabel(name)
|
||||
if m.seasonalities[name]['mode'] == 'multiplicative':
|
||||
ax = set_y_as_percent(ax)
|
||||
return artists
|
||||
|
|
|
|||
Loading…
Reference in a new issue