Multiplicative seasonality (R)

R/R/diagnostics.R

@@ -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

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)

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,68 +1282,28 @@ 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))
-  }
-  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)
-}
+  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]]
 
-#' 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)
+    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)
   }
-  return(components)
+  return(component.predictions)
 }
 
 #' Prophet posterior predictive samples.
@@ -1187,7 +1311,8 @@ add_group_component <- function(components, name, group) {
 #' @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.

R/inst/stan/prophet.stan

@@ -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);
 }

R/man/add_regressor.Rd

@@ -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.
 }

R/man/add_seasonality.Rd

@@ -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.
 }

R/man/make_all_seasonality_features.Rd

@@ -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.

R/man/make_holiday_features.Rd

@@ -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.

R/man/plot_forecast_component.Rd

@@ -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).}

R/man/predictive_samples.Rd

@@ -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.

R/man/prophet.Rd

@@ -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

R/man/prophet_plot_components.Rd

@@ -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.
 }

R/man/regressor_column_matrix.Rd

@@ -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}

R/man/sample_model.Rd

@@ -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.

R/man/sample_posterior_predictive.Rd

@@ -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.

R/tests/testthat/test_diagnostics.R

@@ -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]])
     }

R/tests/testthat/test_prophet.R

@@ -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')
+  )
+})

R/tests/testthat/test_stan_functions.R

@@ -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)

python/fbprophet/forecaster.py

@@ -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
         -------

python/fbprophet/plot.py

@@ -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