Sfoglia il codice sorgente

Multiplicative seasonality (R)

Ben Letham 7 anni fa
parent
commit
7c010aac51

+ 2 - 1
R/R/diagnostics.R

@@ -179,6 +179,7 @@ prophet_copy <- function(m, cutoff = NULL) {
     weekly.seasonality = FALSE,
     weekly.seasonality = FALSE,
     daily.seasonality = FALSE,
     daily.seasonality = FALSE,
     holidays = m$holidays,
     holidays = m$holidays,
+    seasonality.mode = m$seasonality.mode,
     seasonality.prior.scale = m$seasonality.prior.scale,
     seasonality.prior.scale = m$seasonality.prior.scale,
     changepoint.prior.scale = m$changepoint.prior.scale,
     changepoint.prior.scale = m$changepoint.prior.scale,
     holidays.prior.scale = m$holidays.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)
     cols <- c(cols, metric)
   }
   }
   df_m <- df_m[cols]
   df_m <- df_m[cols]
-  return(na.omit(df_m))
+  return(stats::na.omit(df_m))
 }
 }
 
 
 #' Compute a rolling mean of x
 #' Compute a rolling mean of x

+ 41 - 13
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.
 #' 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 m Prophet object.
 #' @param fcst Data frame returned by predict(m, df).
 #' @param fcst Data frame returned by predict(m, df).
@@ -94,11 +95,12 @@ prophet_plot_components <- function(
   yearly_start = 0
   yearly_start = 0
 ) {
 ) {
   # Plot the trend
   # 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.
   # Plot holiday components, if present.
   if (!is.null(m$holidays) && ('holidays' %in% colnames(fcst))) {
   if (!is.null(m$holidays) && ('holidays' %in% colnames(fcst))) {
     panels[[length(panels) + 1]] <- plot_forecast_component(
     panels[[length(panels) + 1]] <- plot_forecast_component(
-      fcst, 'holidays', uncertainty, FALSE)
+      m, fcst, 'holidays', uncertainty, FALSE)
   }
   }
   # Plot weekly seasonality, if present
   # Plot weekly seasonality, if present
   if ("weekly" %in% colnames(fcst)) {
   if ("weekly" %in% colnames(fcst)) {
@@ -116,10 +118,17 @@ prophet_plot_components <- function(
     }
     }
   }
   }
   # Plot extra regressors
   # 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.
   # Make the plot.
@@ -135,6 +144,7 @@ prophet_plot_components <- function(
 
 
 #' Plot a particular component of the forecast.
 #' Plot a particular component of the forecast.
 #'
 #'
+#' @param m Prophet model
 #' @param fcst Dataframe output of `predict`.
 #' @param fcst Dataframe output of `predict`.
 #' @param name String name of the component to plot (column of fcst).
 #' @param name String name of the component to plot (column of fcst).
 #' @param uncertainty Boolean to plot uncertainty intervals.
 #' @param uncertainty Boolean to plot uncertainty intervals.
@@ -145,7 +155,7 @@ prophet_plot_components <- function(
 #'
 #'
 #' @export
 #' @export
 plot_forecast_component <- function(
 plot_forecast_component <- function(
-  fcst, name, uncertainty = TRUE, plot_cap = FALSE
+  m, fcst, name, uncertainty = TRUE, plot_cap = FALSE
 ) {
 ) {
   gg.comp <- ggplot2::ggplot(
   gg.comp <- ggplot2::ggplot(
       fcst, ggplot2::aes_string(x = 'ds', y = name, group = 1)) +
       fcst, ggplot2::aes_string(x = 'ds', y = name, group = 1)) +
@@ -168,6 +178,9 @@ plot_forecast_component <- function(
         fill = "#0072B2",
         fill = "#0072B2",
         na.rm = TRUE)
         na.rm = TRUE)
   }
   }
+  if (name %in% m$component.modes$multiplicative) {
+    gg.comp <- gg.comp + ggplot2::scale_y_continuous(labels = scales::percent)
+  }
   return(gg.comp)
   return(gg.comp)
 }
 }
 
 
@@ -220,6 +233,11 @@ plot_weekly <- function(m, uncertainty = TRUE, weekly_start = 0) {
                            fill = "#0072B2",
                            fill = "#0072B2",
                            na.rm = TRUE)
                            na.rm = TRUE)
   }
   }
+  if (m$seasonalities$weekly$mode == 'multiplicative') {
+    gg.weekly <- (
+      gg.weekly + ggplot2::scale_y_continuous(labels = scales::percent)
+    )
+  }
   return(gg.weekly)
   return(gg.weekly)
 }
 }
 
 
@@ -255,6 +273,11 @@ plot_yearly <- function(m, uncertainty = TRUE, yearly_start = 0) {
                            fill = "#0072B2",
                            fill = "#0072B2",
                            na.rm = TRUE)
                            na.rm = TRUE)
   }
   }
+  if (m$seasonalities$yearly$mode == 'multiplicative') {
+    gg.yearly <- (
+      gg.yearly + ggplot2::scale_y_continuous(labels = scales::percent)
+    )
+  }
   return(gg.yearly)
   return(gg.yearly)
 }
 }
 
 
@@ -299,6 +322,9 @@ plot_seasonality <- function(m, name, uncertainty = TRUE) {
       fill = "#0072B2",
       fill = "#0072B2",
       na.rm = TRUE)
       na.rm = TRUE)
   }
   }
+  if (m$seasonalities[[name]]$mode == 'multiplicative') {
+    gg.s <- gg.s + ggplot2::scale_y_continuous(labels = scales::percent)
+  }
   return(gg.s)
   return(gg.s)
 }
 }
 
 
@@ -386,8 +412,7 @@ dyplot.prophet <- function(x, fcst, uncertainty=TRUE,
       dygraphs::dyAnnotation(x, text, text, attachAtBottom = TRUE)
       dygraphs::dyAnnotation(x, text, text, attachAtBottom = TRUE)
   }
   }
   
   
-  dyBase <- dyBase %>% 
-    dygraphs::dyOptions(colors = RColorBrewer::brewer.pal(3, "Set1")) %>%
+  dyBase <- dyBase %>%
     # plot actual values
     # plot actual values
     dygraphs::dySeries('y', label=actual.label) %>% 
     dygraphs::dySeries('y', label=actual.label) %>% 
     # plot forecast and ribbon
     # plot forecast and ribbon
@@ -399,8 +424,11 @@ dyplot.prophet <- function(x, fcst, uncertainty=TRUE,
   if (!is.null(x$holidays)) {
   if (!is.null(x$holidays)) {
     for (i in 1:nrow(x$holidays)) {
     for (i in 1:nrow(x$holidays)) {
       # make a gray line
       # 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)
   return(dyBase)

+ 220 - 86
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
 #'  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
 #'  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.
 #'  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
 #' @param seasonality.prior.scale Parameter modulating the strength of the
 #'  seasonality model. Larger values allow the model to fit larger seasonal
 #'  seasonality model. Larger values allow the model to fit larger seasonal
 #'  fluctuations, smaller values dampen the seasonality. Can be specified for
 #'  fluctuations, smaller values dampen the seasonality. Can be specified for
@@ -82,6 +83,7 @@ prophet <- function(df = NULL,
                     weekly.seasonality = 'auto',
                     weekly.seasonality = 'auto',
                     daily.seasonality = 'auto',
                     daily.seasonality = 'auto',
                     holidays = NULL,
                     holidays = NULL,
+                    seasonality.mode = 'additive',
                     seasonality.prior.scale = 10,
                     seasonality.prior.scale = 10,
                     holidays.prior.scale = 10,
                     holidays.prior.scale = 10,
                     changepoint.prior.scale = 0.05,
                     changepoint.prior.scale = 0.05,
@@ -105,6 +107,7 @@ prophet <- function(df = NULL,
     weekly.seasonality = weekly.seasonality,
     weekly.seasonality = weekly.seasonality,
     daily.seasonality = daily.seasonality,
     daily.seasonality = daily.seasonality,
     holidays = holidays,
     holidays = holidays,
+    seasonality.mode = seasonality.mode,
     seasonality.prior.scale = seasonality.prior.scale,
     seasonality.prior.scale = seasonality.prior.scale,
     changepoint.prior.scale = changepoint.prior.scale,
     changepoint.prior.scale = changepoint.prior.scale,
     holidays.prior.scale = holidays.prior.scale,
     holidays.prior.scale = holidays.prior.scale,
@@ -122,7 +125,9 @@ prophet <- function(df = NULL,
     stan.fit = NULL,
     stan.fit = NULL,
     params = list(),
     params = list(),
     history = NULL,
     history = NULL,
-    history.dates = NULL
+    history.dates = NULL,
+    train.component.cols = NULL,
+    component.modes = NULL
   )
   )
   validate_inputs(m)
   validate_inputs(m)
   class(m) <- append("prophet", class(m))
   class(m) <- append("prophet", class(m))
@@ -168,6 +173,9 @@ validate_inputs <- function(m) {
       validate_column_name(m, h, check_holidays = FALSE)
       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.
 #' Validates the name of a seasonality, holiday, or regressor.
@@ -187,8 +195,9 @@ validate_column_name <- function(
     stop('Holiday name cannot contain "_delim_"')
     stop('Holiday name cannot contain "_delim_"')
   }
   }
   reserved_names = c(
   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_l = paste0(reserved_names,"_lower")
   rn_u = paste0(reserved_names,"_upper")
   rn_u = paste0(reserved_names,"_upper")
@@ -511,6 +520,7 @@ make_seasonality_features <- function(dates, period, series.order, prefix) {
 #' @return A list with entries
 #' @return A list with entries
 #'  holiday.features: dataframe with a column for each holiday.
 #'  holiday.features: dataframe with a column for each holiday.
 #'  prior.scales: array of prior scales for each holiday column.
 #'  prior.scales: array of prior scales for each holiday column.
+#'  holiday.names: array of names of all holidays.
 #'
 #'
 #' @importFrom dplyr "%>%"
 #' @importFrom dplyr "%>%"
 #' @keywords internal
 #' @keywords internal
@@ -568,7 +578,8 @@ make_holiday_features <- function(m, dates) {
     prior.scales <- c(prior.scales, prior.scales.list[[sn]])
     prior.scales <- c(prior.scales, prior.scales.list[[sn]])
   }
   }
   return(list(holiday.features = holiday.features,
   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.
 #' 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.
 #' coefficient is given a prior with the specified scale parameter.
 #' Decreasing the prior scale will add additional regularization. If no
 #' Decreasing the prior scale will add additional regularization. If no
 #' prior scale is provided, holidays.prior.scale will be used.
 #' 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 m Prophet object.
 #' @param name String name of the regressor
 #' @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
 #' @param standardize Bool, specify whether this regressor will be standardized
 #'  prior to fitting. Can be 'auto' (standardize if not binary), True, or
 #'  prior to fitting. Can be 'auto' (standardize if not binary), True, or
 #'  False.
 #'  False.
+#' @param mode Optional, 'additive' or 'multiplicative'. Defaults to
+#'  m$seasonality.mode.
 #'
 #'
 #' @return  The prophet model with the regressor added.
 #' @return  The prophet model with the regressor added.
 #'
 #'
 #' @export
 #' @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)) {
   if (!is.null(m$history)) {
     stop('Regressors must be added prior to model fitting.')
     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)) {
   if (is.null(prior.scale)) {
     prior.scale <- m$holidays.prior.scale
     prior.scale <- m$holidays.prior.scale
   }
   }
+  if (is.null(mode)) {
+    mode <- m$seasonality.mode
+  }
   if(prior.scale <= 0) {
   if(prior.scale <= 0) {
     stop("Prior scale must be > 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(
   m$extra_regressors[[name]] <- list(
     prior.scale = prior.scale,
     prior.scale = prior.scale,
     standardize = standardize,
     standardize = standardize,
     mu = 0,
     mu = 0,
-    std = 1.0
+    std = 1.0,
+    mode = mode
   )
   )
   return(m)
   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
 #' flexibility, decreasing will dampen it. If not provided, will use the
 #' seasonality.prior.scale provided on Prophet initialization (defaults to 10).
 #' 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 m Prophet object.
 #' @param name String name of the seasonality component.
 #' @param name String name of the seasonality component.
 #' @param period Float number of days in one period.
 #' @param period Float number of days in one period.
 #' @param fourier.order Int number of Fourier components to use.
 #' @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.
 #' @return The prophet model with the seasonality added.
 #'
 #'
 #' @importFrom dplyr "%>%"
 #' @importFrom dplyr "%>%"
 #' @export
 #' @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)) {
   if (!is.null(m$history)) {
     stop("Seasonality must be added prior to model fitting.")
     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) {
   if (ps <= 0) {
     stop('Prior scale must be > 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(
   m$seasonalities[[name]] <- list(
     period = period,
     period = period,
     fourier.order = fourier.order,
     fourier.order = fourier.order,
-    prior.scale = ps
+    prior.scale = ps,
+    mode = mode
   )
   )
   return(m)
   return(m)
 }
 }
@@ -667,11 +708,16 @@ add_seasonality <- function(m, name, period, fourier.order, prior.scale = NULL)
 #'  seasonal.features: Dataframe with regressor features,
 #'  seasonal.features: Dataframe with regressor features,
 #'  prior.scales: Array of prior scales for each colum of the features
 #'  prior.scales: Array of prior scales for each colum of the features
 #'    dataframe.
 #'    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
 #' @keywords internal
 make_all_seasonality_features <- function(m, df) {
 make_all_seasonality_features <- function(m, df) {
   seasonal.features <- data.frame(row.names = seq_len(nrow(df)))
   seasonal.features <- data.frame(row.names = seq_len(nrow(df)))
   prior.scales <- c()
   prior.scales <- c()
+  modes <- list(additive = c(), multiplicative = c())
 
 
   # Seasonality features
   # Seasonality features
   for (name in names(m$seasonalities)) {
   for (name in names(m$seasonalities)) {
@@ -681,6 +727,7 @@ make_all_seasonality_features <- function(m, df) {
     seasonal.features <- cbind(seasonal.features, features)
     seasonal.features <- cbind(seasonal.features, features)
     prior.scales <- c(prior.scales,
     prior.scales <- c(prior.scales,
                       props$prior.scale * rep(1, ncol(features)))
                       props$prior.scale * rep(1, ncol(features)))
+    modes[[props$mode]] <- c(modes[[props$mode]], name)
   }
   }
 
 
   # Holiday features
   # Holiday features
@@ -688,20 +735,129 @@ make_all_seasonality_features <- function(m, df) {
     hf <- make_holiday_features(m, df$ds)
     hf <- make_holiday_features(m, df$ds)
     seasonal.features <- cbind(seasonal.features, hf$holiday.features)
     seasonal.features <- cbind(seasonal.features, hf$holiday.features)
     prior.scales <- c(prior.scales, hf$prior.scales)
     prior.scales <- c(prior.scales, hf$prior.scales)
+    modes[[m$seasonality.mode]] <- c(
+      modes[[m$seasonality.mode]], hf$holiday.names)
   }
   }
 
 
   # Additional regressors
   # Additional regressors
   for (name in names(m$extra_regressors)) {
   for (name in names(m$extra_regressors)) {
+    props <- m$extra_regressors[[name]]
     seasonal.features[[name]] <- df[[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) {
   if (ncol(seasonal.features) == 0) {
     seasonal.features <- data.frame(zeros = rep(0, nrow(df)))
     seasonal.features <- data.frame(zeros = rep(0, nrow(df)))
     prior.scales <- 1
     prior.scales <- 1
   }
   }
+
+  components.list <- regressor_column_matrix(m, seasonal.features, modes)
   return(list(seasonal.features = seasonal.features,
   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.
 #' Get number of Fourier components for built-in seasonalities.
@@ -764,7 +920,8 @@ set_auto_seasonalities <- function(m) {
     m$seasonalities[['yearly']] <- list(
     m$seasonalities[['yearly']] <- list(
       period = 365.25,
       period = 365.25,
       fourier.order = fourier.order,
       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(
     m$seasonalities[['weekly']] <- list(
       period = 7,
       period = 7,
       fourier.order = fourier.order,
       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(
     m$seasonalities[['daily']] <- list(
       period = 1,
       period = 1,
       fourier.order = fourier.order,
       fourier.order = fourier.order,
-      prior.scale = m$seasonality.prior.scale
+      prior.scale = m$seasonality.prior.scale,
+      mode = m$seasonality.mode
     )
     )
   }
   }
   return(m)
   return(m)
@@ -891,6 +1050,9 @@ fit.prophet <- function(m, df, ...) {
   out2 <- make_all_seasonality_features(m, history)
   out2 <- make_all_seasonality_features(m, history)
   seasonal.features <- out2$seasonal.features
   seasonal.features <- out2$seasonal.features
   prior.scales <- out2$prior.scales
   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)
   m <- set_changepoints(m)
 
 
@@ -905,7 +1067,9 @@ fit.prophet <- function(m, df, ...) {
     X = as.matrix(seasonal.features),
     X = as.matrix(seasonal.features),
     sigmas = array(prior.scales),
     sigmas = array(prior.scales),
     tau = m$changepoint.prior.scale,
     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
   # Run stan
@@ -1023,7 +1187,7 @@ predict.prophet <- function(object, df = NULL, ...) {
   }
   }
   df <- df[cols]
   df <- df[cols]
   df <- dplyr::bind_cols(df, seasonal.components, intervals)
   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)
   return(df)
 }
 }
 
 
@@ -1118,68 +1282,28 @@ predict_trend <- function(model, df) {
 #'
 #'
 #' @keywords internal
 #' @keywords internal
 predict_seasonal_components <- function(m, df) {
 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
   lower.p <- (1 - m$interval.width)/2
   upper.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.
 #' Prophet posterior predictive samples.
@@ -1187,7 +1311,8 @@ add_group_component <- function(components, name, group) {
 #' @param m Prophet object.
 #' @param m Prophet object.
 #' @param df Prediction dataframe.
 #' @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
 #' @keywords internal
 sample_posterior_predictive <- function(m, df) {
 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))
   samp.per.iter <- max(1, ceiling(m$uncertainty.samples / n.iterations))
   nsamp <- n.iterations * samp.per.iter  # The actual number of samples
   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),
   sim.values <- list("trend" = matrix(, nrow = nrow(df), ncol = nsamp),
-                     "seasonal" = matrix(, nrow = nrow(df), ncol = nsamp),
                      "yhat" = matrix(, nrow = nrow(df), ncol = nsamp))
                      "yhat" = matrix(, nrow = nrow(df), ncol = nsamp))
 
 
   for (i in seq_len(n.iterations)) {
   for (i in seq_len(n.iterations)) {
     # For each set of parameters from MCMC (or just 1 set for MAP),
     # For each set of parameters from MCMC (or just 1 set for MAP),
     for (j in seq_len(samp.per.iter)) {
     for (j in seq_len(samp.per.iter)) {
       # Do a simulation with this set of parameters,
       # 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
       # Store the results
       for (key in c("trend", "seasonal", "yhat")) {
       for (key in c("trend", "seasonal", "yhat")) {
         sim.values[[key]][,(i - 1) * samp.per.iter + j] <- sim[[key]]
         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
 #' @param df Dataframe with dates for predictions (column ds), and capacity
 #'  (column cap) if logistic growth.
 #'  (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
 #' @export
 predictive_samples <- function(m, df) {
 predictive_samples <- function(m, df) {
@@ -1264,22 +1396,24 @@ predict_uncertainty <- function(m, df) {
 #' @param df Prediction dataframe.
 #' @param df Prediction dataframe.
 #' @param seasonal.features Data frame of seasonal features
 #' @param seasonal.features Data frame of seasonal features
 #' @param iteration Int sampling iteration to use parameters from.
 #' @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
 #' @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)
   trend <- sample_predictive_trend(m, df, iteration)
 
 
   beta <- m$params$beta[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]
   sigma <- m$params$sigma_obs[iteration]
   noise <- stats::rnorm(nrow(df), mean = 0, sd = sigma) * m$y.scale
   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.
 #' Simulate the trend using the extrapolated generative model.

+ 8 - 1
R/inst/stan/prophet.stan

@@ -85,6 +85,8 @@ data {
   vector[K] sigmas;     // Scale on seasonality prior
   vector[K] sigmas;     // Scale on seasonality prior
   real<lower=0> tau;    // Scale on changepoints prior
   real<lower=0> tau;    // Scale on changepoints prior
   int trend_indicator;  // 0 for linear, 1 for logistic
   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 {
 transformed data {
@@ -102,12 +104,17 @@ parameters {
 
 
 transformed parameters {
 transformed parameters {
   vector[T] trend;
   vector[T] trend;
+  vector[T] Xb_a;
+  vector[T] Xb_m;
 
 
   if (trend_indicator == 0) {
   if (trend_indicator == 0) {
     trend = linear_trend(k, m, delta, t, A, t_change);
     trend = linear_trend(k, m, delta, t, A, t_change);
   } else if (trend_indicator == 1) {
   } else if (trend_indicator == 1) {
     trend = logistic_trend(k, m, delta, t, cap, A, t_change, S);
     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 {
 model {
@@ -119,5 +126,5 @@ model {
   beta ~ normal(0, sigmas);
   beta ~ normal(0, sigmas);
 
 
   // Likelihood
   // Likelihood
-  y ~ normal(trend + X * beta, sigma_obs);
+  y ~ normal(trend .* (1 + Xb_m) + Xb_a, sigma_obs);
 }
 }

+ 9 - 1
R/man/add_regressor.Rd

@@ -4,7 +4,8 @@
 \alias{add_regressor}
 \alias{add_regressor}
 \title{Add an additional regressor to be used for fitting and predicting.}
 \title{Add an additional regressor to be used for fitting and predicting.}
 \usage{
 \usage{
-add_regressor(m, name, prior.scale = NULL, standardize = "auto")
+add_regressor(m, name, prior.scale = NULL, standardize = "auto",
+  mode = NULL)
 }
 }
 \arguments{
 \arguments{
 \item{m}{Prophet object.}
 \item{m}{Prophet object.}
@@ -17,6 +18,9 @@ holidays.prior.scale will be used.}
 \item{standardize}{Bool, specify whether this regressor will be standardized
 \item{standardize}{Bool, specify whether this regressor will be standardized
 prior to fitting. Can be 'auto' (standardize if not binary), True, or
 prior to fitting. Can be 'auto' (standardize if not binary), True, or
 False.}
 False.}
+
+\item{mode}{Optional, 'additive' or 'multiplicative'. Defaults to
+m$seasonality.mode.}
 }
 }
 \value{
 \value{
 The prophet model with the regressor added.
 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.
 coefficient is given a prior with the specified scale parameter.
 Decreasing the prior scale will add additional regularization. If no
 Decreasing the prior scale will add additional regularization. If no
 prior scale is provided, holidays.prior.scale will be used.
 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.
 }
 }

+ 10 - 2
R/man/add_seasonality.Rd

@@ -5,7 +5,8 @@
 \title{Add a seasonal component with specified period, number of Fourier
 \title{Add a seasonal component with specified period, number of Fourier
 components, and prior scale.}
 components, and prior scale.}
 \usage{
 \usage{
-add_seasonality(m, name, period, fourier.order, prior.scale = NULL)
+add_seasonality(m, name, period, fourier.order, prior.scale = NULL,
+  mode = NULL)
 }
 }
 \arguments{
 \arguments{
 \item{m}{Prophet object.}
 \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{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{
 \value{
 The prophet model with the seasonality added.
 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
 Increasing prior scale will allow this seasonality component more
 flexibility, decreasing will dampen it. If not provided, will use the
 flexibility, decreasing will dampen it. If not provided, will use the
 seasonality.prior.scale provided on Prophet initialization (defaults to 10).
 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.
 }
 }

+ 4 - 0
R/man/make_all_seasonality_features.Rd

@@ -18,6 +18,10 @@ List with items
  seasonal.features: Dataframe with regressor features,
  seasonal.features: Dataframe with regressor features,
  prior.scales: Array of prior scales for each colum of the features
  prior.scales: Array of prior scales for each colum of the features
    dataframe.
    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{
 \description{
 Dataframe with seasonality features.
 Dataframe with seasonality features.

+ 1 - 0
R/man/make_holiday_features.Rd

@@ -15,6 +15,7 @@ make_holiday_features(m, dates)
 A list with entries
 A list with entries
  holiday.features: dataframe with a column for each holiday.
  holiday.features: dataframe with a column for each holiday.
  prior.scales: array of prior scales for each holiday column.
  prior.scales: array of prior scales for each holiday column.
+ holiday.names: array of names of all holidays.
 }
 }
 \description{
 \description{
 Construct a matrix of holiday features.
 Construct a matrix of holiday features.

+ 3 - 1
R/man/plot_forecast_component.Rd

@@ -4,9 +4,11 @@
 \alias{plot_forecast_component}
 \alias{plot_forecast_component}
 \title{Plot a particular component of the forecast.}
 \title{Plot a particular component of the forecast.}
 \usage{
 \usage{
-plot_forecast_component(fcst, name, uncertainty = TRUE, plot_cap = FALSE)
+plot_forecast_component(m, fcst, name, uncertainty = TRUE, plot_cap = FALSE)
 }
 }
 \arguments{
 \arguments{
+\item{m}{Prophet model}
+
 \item{fcst}{Dataframe output of `predict`.}
 \item{fcst}{Dataframe output of `predict`.}
 
 
 \item{name}{String name of the component to plot (column of fcst).}
 \item{name}{String name of the component to plot (column of fcst).}

+ 2 - 3
R/man/predictive_samples.Rd

@@ -13,9 +13,8 @@ predictive_samples(m, df)
 (column cap) if logistic growth.}
 (column cap) if logistic growth.}
 }
 }
 \value{
 \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{
 \description{
 Sample from the posterior predictive distribution.
 Sample from the posterior predictive distribution.

+ 6 - 4
R/man/prophet.Rd

@@ -7,10 +7,10 @@
 prophet(df = NULL, growth = "linear", changepoints = NULL,
 prophet(df = NULL, growth = "linear", changepoints = NULL,
   n.changepoints = 25, yearly.seasonality = "auto",
   n.changepoints = 25, yearly.seasonality = "auto",
   weekly.seasonality = "auto", daily.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{
 \arguments{
 \item{df}{(optional) Dataframe containing the history. Must have columns ds
 \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
 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.}
 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
 \item{seasonality.prior.scale}{Parameter modulating the strength of the
 seasonality model. Larger values allow the model to fit larger seasonal
 seasonality model. Larger values allow the model to fit larger seasonal
 fluctuations, smaller values dampen the seasonality. Can be specified for
 fluctuations, smaller values dampen the seasonality. Can be specified for

+ 6 - 4
R/man/prophet_plot_components.Rd

@@ -3,8 +3,9 @@
 \name{prophet_plot_components}
 \name{prophet_plot_components}
 \alias{prophet_plot_components}
 \alias{prophet_plot_components}
 \title{Plot the components of a prophet forecast.
 \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{
 \usage{
 prophet_plot_components(m, fcst, uncertainty = TRUE, plot_cap = TRUE,
 prophet_plot_components(m, fcst, uncertainty = TRUE, plot_cap = TRUE,
   weekly_start = 0, yearly_start = 0)
   weekly_start = 0, yearly_start = 0)
@@ -33,6 +34,7 @@ Invisibly return a list containing the plotted ggplot objects
 }
 }
 \description{
 \description{
 Plot the components of a prophet forecast.
 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 - 0
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}

+ 6 - 2
R/man/sample_model.Rd

@@ -4,7 +4,7 @@
 \alias{sample_model}
 \alias{sample_model}
 \title{Simulate observations from the extrapolated generative model.}
 \title{Simulate observations from the extrapolated generative model.}
 \usage{
 \usage{
-sample_model(m, df, seasonal.features, iteration)
+sample_model(m, df, seasonal.features, iteration, s_a, s_m)
 }
 }
 \arguments{
 \arguments{
 \item{m}{Prophet object.}
 \item{m}{Prophet object.}
@@ -14,9 +14,13 @@ sample_model(m, df, seasonal.features, iteration)
 \item{seasonal.features}{Data frame of seasonal features}
 \item{seasonal.features}{Data frame of seasonal features}
 
 
 \item{iteration}{Int sampling iteration to use parameters from.}
 \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{
 \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{
 \description{
 Simulate observations from the extrapolated generative model.
 Simulate observations from the extrapolated generative model.

+ 2 - 1
R/man/sample_posterior_predictive.Rd

@@ -12,7 +12,8 @@ sample_posterior_predictive(m, df)
 \item{df}{Prediction dataframe.}
 \item{df}{Prediction dataframe.}
 }
 }
 \value{
 \value{
-List with posterior predictive samples for each component.
+List with posterior predictive samples for the forecast yhat and
+ for the trend component.
 }
 }
 \description{
 \description{
 Prophet posterior predictive samples.
 Prophet posterior predictive samples.

+ 3 - 2
R/tests/testthat/test_diagnostics.R

@@ -144,7 +144,8 @@ test_that("copy", {
     yearly.seasonality = c(TRUE, FALSE),
     yearly.seasonality = c(TRUE, FALSE),
     weekly.seasonality = c(TRUE, FALSE),
     weekly.seasonality = c(TRUE, FALSE),
     daily.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)
   products <- expand.grid(inputs)
   for (i in 1:length(products)) {
   for (i in 1:length(products)) {
@@ -178,7 +179,7 @@ test_that("copy", {
     args <- c('growth', 'changepoints', 'n.changepoints', 'holidays',
     args <- c('growth', 'changepoints', 'n.changepoints', 'holidays',
               'seasonality.prior.scale', 'holidays.prior.scale',
               'seasonality.prior.scale', 'holidays.prior.scale',
               'changepoints.prior.scale', 'mcmc.samples', 'interval.width',
               'changepoints.prior.scale', 'mcmc.samples', 'interval.width',
-              'uncertainty.samples')
+              'uncertainty.samples', 'seasonality.mode')
     for (arg in args) {
     for (arg in args) {
       expect_equal(m1[[arg]], m2[[arg]])
       expect_equal(m1[[arg]], m2[[arg]])
     }
     }

+ 123 - 26
R/tests/testthat/test_prophet.R

@@ -225,7 +225,7 @@ test_that("piecewise_logistic", {
 })
 })
 
 
 test_that("holidays", {
 test_that("holidays", {
-  holidays = data.frame(ds = c('2016-12-25'),
+  holidays <- data.frame(ds = c('2016-12-25'),
                         holiday = c('xmas'),
                         holiday = c('xmas'),
                         lower_window = c(-1),
                         lower_window = c(-1),
                         upper_window = c(0))
                         upper_window = c(0))
@@ -236,12 +236,14 @@ test_that("holidays", {
   out <- prophet:::make_holiday_features(m, df$ds)
   out <- prophet:::make_holiday_features(m, df$ds)
   feats <- out$holiday.features
   feats <- out$holiday.features
   priors <- out$prior.scales
   priors <- out$prior.scales
+  names <- out$holiday.names
   expect_equal(nrow(feats), nrow(df))
   expect_equal(nrow(feats), nrow(df))
   expect_equal(ncol(feats), 2)
   expect_equal(ncol(feats), 2)
   expect_equal(sum(colSums(feats) - c(1, 1)), 0)
   expect_equal(sum(colSums(feats) - c(1, 1)), 0)
   expect_true(all(priors == c(10., 10.)))
   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'),
                         holiday = c('xmas'),
                         lower_window = c(-1),
                         lower_window = c(-1),
                         upper_window = c(10))
                         upper_window = c(10))
@@ -249,9 +251,11 @@ test_that("holidays", {
   out <- prophet:::make_holiday_features(m, df$ds)
   out <- prophet:::make_holiday_features(m, df$ds)
   feats <- out$holiday.features
   feats <- out$holiday.features
   priors <- out$prior.scales
   priors <- out$prior.scales
+  names <- out$holiday.names
   expect_equal(nrow(feats), nrow(df))
   expect_equal(nrow(feats), nrow(df))
   expect_equal(ncol(feats), 12)
   expect_equal(ncol(feats), 12)
   expect_true(all(priors == rep(10, 12)))
   expect_true(all(priors == rep(10, 12)))
+  expect_equal(names, c('xmas'))
   # Check prior specifications
   # Check prior specifications
   holidays <- data.frame(
   holidays <- data.frame(
     ds = prophet:::set_date(c('2016-12-25', '2017-12-25')),
     ds = prophet:::set_date(c('2016-12-25', '2017-12-25')),
@@ -263,7 +267,9 @@ test_that("holidays", {
   m <- prophet(holidays = holidays, fit = FALSE)
   m <- prophet(holidays = holidays, fit = FALSE)
   out <- prophet:::make_holiday_features(m, df$ds)
   out <- prophet:::make_holiday_features(m, df$ds)
   priors <- out$prior.scales
   priors <- out$prior.scales
+  names <- out$holiday.names
   expect_true(all(priors == c(5., 5.)))
   expect_true(all(priors == c(5., 5.)))
+  expect_equal(names, c('xmas'))
   # 2 different priors
   # 2 different priors
   holidays2 <- data.frame(
   holidays2 <- data.frame(
     ds = prophet:::set_date(c('2012-06-06', '2013-06-06')),
     ds = prophet:::set_date(c('2012-06-06', '2013-06-06')),
@@ -276,7 +282,9 @@ test_that("holidays", {
   m <- prophet(holidays = holidays2, fit = FALSE)
   m <- prophet(holidays = holidays2, fit = FALSE)
   out <- prophet:::make_holiday_features(m, df$ds)
   out <- prophet:::make_holiday_features(m, df$ds)
   priors <- out$prior.scales
   priors <- out$prior.scales
+  names <- out$holiday.names
   expect_true(all(priors == c(8, 8, 5, 5)))
   expect_true(all(priors == c(8, 8, 5, 5)))
+  expect_true(all(sort(names) == c('seans-bday', 'xmas')))
   holidays2 <- data.frame(
   holidays2 <- data.frame(
     ds = prophet:::set_date(c('2012-06-06', '2013-06-06')),
     ds = prophet:::set_date(c('2012-06-06', '2013-06-06')),
     holiday = c('seans-bday', 'seans-bday'),
     holiday = c('seans-bday', 'seans-bday'),
@@ -334,7 +342,8 @@ test_that("auto_weekly_seasonality", {
   expect_equal(m$weekly.seasonality, 'auto')
   expect_equal(m$weekly.seasonality, 'auto')
   m <- fit.prophet(m, train.w)
   m <- fit.prophet(m, train.w)
   expect_true('weekly' %in% names(m$seasonalities))
   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)) {
   for (name in names(true)) {
     expect_equal(m$seasonalities$weekly[[name]], true[[name]])
     expect_equal(m$seasonalities$weekly[[name]], true[[name]])
   }
   }
@@ -350,7 +359,8 @@ test_that("auto_weekly_seasonality", {
   m <- prophet(train.w)
   m <- prophet(train.w)
   expect_false('weekly' %in% names(m$seasonalities))
   expect_false('weekly' %in% names(m$seasonalities))
   m <- prophet(DATA, weekly.seasonality = 2, seasonality.prior.scale = 3)
   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)) {
   for (name in names(true)) {
     expect_equal(m$seasonalities$weekly[[name]], true[[name]])
     expect_equal(m$seasonalities$weekly[[name]], true[[name]])
   }
   }
@@ -363,7 +373,8 @@ test_that("auto_yearly_seasonality", {
   expect_equal(m$yearly.seasonality, 'auto')
   expect_equal(m$yearly.seasonality, 'auto')
   m <- fit.prophet(m, DATA)
   m <- fit.prophet(m, DATA)
   expect_true('yearly' %in% names(m$seasonalities))
   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)) {
   for (name in names(true)) {
     expect_equal(m$seasonalities$yearly[[name]], true[[name]])
     expect_equal(m$seasonalities$yearly[[name]], true[[name]])
   }
   }
@@ -375,7 +386,8 @@ test_that("auto_yearly_seasonality", {
   m <- prophet(train.y, yearly.seasonality = TRUE)
   m <- prophet(train.y, yearly.seasonality = TRUE)
   expect_true('yearly' %in% names(m$seasonalities))
   expect_true('yearly' %in% names(m$seasonalities))
   m <- prophet(DATA, yearly.seasonality = 7, seasonality.prior.scale = 3)
   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)) {
   for (name in names(true)) {
     expect_equal(m$seasonalities$yearly[[name]], true[[name]])
     expect_equal(m$seasonalities$yearly[[name]], true[[name]])
   }
   }
@@ -388,7 +400,8 @@ test_that("auto_daily_seasonality", {
   expect_equal(m$daily.seasonality, 'auto')
   expect_equal(m$daily.seasonality, 'auto')
   m <- fit.prophet(m, DATA2)
   m <- fit.prophet(m, DATA2)
   expect_true('daily' %in% names(m$seasonalities))
   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)) {
   for (name in names(true)) {
     expect_equal(m$seasonalities$daily[[name]], true[[name]])
     expect_equal(m$seasonalities$daily[[name]], true[[name]])
   }
   }
@@ -400,7 +413,8 @@ test_that("auto_daily_seasonality", {
   m <- prophet(train.y, daily.seasonality = TRUE)
   m <- prophet(train.y, daily.seasonality = TRUE)
   expect_true('daily' %in% names(m$seasonalities))
   expect_true('daily' %in% names(m$seasonalities))
   m <- prophet(DATA2, daily.seasonality = 7, seasonality.prior.scale = 3)
   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)) {
   for (name in names(true)) {
     expect_equal(m$seasonalities$daily[[name]], true[[name]])
     expect_equal(m$seasonalities$daily[[name]], true[[name]])
   }
   }
@@ -424,7 +438,8 @@ test_that("custom_seasonality", {
                          prior_scale = c(4))
                          prior_scale = c(4))
   m <- prophet(holidays=holidays)
   m <- prophet(holidays=holidays)
   m <- add_seasonality(m, name='monthly', period=30, fourier.order=5)
   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)) {
   for (name in names(true)) {
     expect_equal(m$seasonalities$monthly[[name]], true[[name]])
     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)
   m <- add_seasonality(m, name='weekly', period=30, fourier.order=5)
   # Test priors
   # Test priors
-  m <- prophet(holidays = holidays, yearly.seasonality = FALSE)
+  m <- prophet(
+    holidays = holidays, yearly.seasonality = FALSE,
+    seasonality.mode = 'multiplicative')
   m <- add_seasonality(
   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)
   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)))
   expect_true(all(prior.scales == c(rep(2, 10), rep(10, 6), 4)))
 })
 })
 
 
@@ -450,10 +478,13 @@ test_that("added_regressors", {
   m <- prophet()
   m <- prophet()
   m <- add_regressor(m, 'binary_feature', prior.scale=0.2)
   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_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)
   m <- add_regressor(m, 'binary_feature2', standardize=TRUE)
   df <- DATA
   df <- DATA
   df$binary_feature <- c(rep(0, 255), rep(1, 255))
   df$binary_feature <- c(rep(0, 255), rep(1, 255))
   df$numeric_feature <- 0:509
   df$numeric_feature <- 0:509
+  df$numeric_feature2 <- 0:509
   # Require all regressors in df
   # Require all regressors in df
   expect_error(
   expect_error(
     fit.prophet(m, df)
     fit.prophet(m, df)
@@ -461,7 +492,9 @@ test_that("added_regressors", {
   df$binary_feature2 <- c(rep(1, 100), rep(0, 410))
   df$binary_feature2 <- c(rep(1, 100), rep(0, 410))
   m <- fit.prophet(m, df)
   m <- fit.prophet(m, df)
   # Check that standardizations are correctly set
   # 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)) {
   for (name in names(true)) {
     expect_equal(true[[name]], m$extra_regressors$binary_feature[[name]])
     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]],
     expect_equal(true[[name]], m$extra_regressors$numeric_feature[[name]],
                  tolerance = 1e-5)
                  tolerance = 1e-5)
   }
   }
+  expect_equal(m$extra_regressors$numeric_feature2$mode, 'multiplicative')
   true <- list(prior.scale = 10., mu = 0.1960784, std = 0.3974183)
   true <- list(prior.scale = 10., mu = 0.1960784, std = 0.3974183)
   for (name in names(true)) {
   for (name in names(true)) {
     expect_equal(true[[name]], m$extra_regressors$binary_feature2[[name]],
     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)
   out <- prophet:::make_all_seasonality_features(m, df2)
   seasonal.features <- out$seasonal.features
   seasonal.features <- out$seasonal.features
   prior.scales <- out$prior.scales
   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
   # Check that forecast components are reasonable
   future <- data.frame(
   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))
   expect_error(predict(m, future))
   future$binary_feature2 <- 0.
   future$binary_feature2 <- 0.
   fcst <- predict(m, future)
   fcst <- predict(m, future)
-  expect_equal(ncol(fcst), 31)
+  expect_equal(ncol(fcst), 37)
   expect_equal(fcst$binary_feature[1], 0)
   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])
                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
   # Check fails if constant extra regressor
   df$constant_feature <- 5
   df$constant_feature <- 5
   m <- prophet()
   m <- prophet()
   m <- add_regressor(m, 'constant_feature')
   m <- add_regressor(m, 'constant_feature')
   expect_error(fit.prophet(m, df))
   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')
+  )
+})

+ 9 - 3
R/tests/testthat/test_stan_functions.R

@@ -1,9 +1,15 @@
 library(prophet)
 library(prophet)
 context("Prophet stan model tests")
 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')
 DATA <- read.csv('data.csv')
 N <- nrow(DATA)
 N <- nrow(DATA)

+ 4 - 2
python/fbprophet/forecaster.py

@@ -692,7 +692,7 @@ class Prophet(object):
         # Convert to a binary matrix
         # Convert to a binary matrix
         component_cols = pd.crosstab(
         component_cols = pd.crosstab(
             components['col'], components['component'],
             components['col'], components['component'],
-        )
+        ).sort_index(level='col')
         # Add columns for additive and multiplicative terms, if missing
         # Add columns for additive and multiplicative terms, if missing
         for name in ['additive_terms', 'multiplicative_terms']:
         for name in ['additive_terms', 'multiplicative_terms']:
             if name not in component_cols:
             if name not in component_cols:
@@ -729,7 +729,7 @@ class Prophet(object):
         new_comp = components[components['component'].isin(set(group))].copy()
         new_comp = components[components['component'].isin(set(group))].copy()
         group_cols = new_comp['col'].unique()
         group_cols = new_comp['col'].unique()
         if len(group_cols) > 0:
         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)
             components = components.append(new_comp)
         return components
         return components
 
 
@@ -1248,6 +1248,8 @@ class Prophet(object):
         df: Prediction dataframe.
         df: Prediction dataframe.
         seasonal_features: pd.DataFrame of seasonal features.
         seasonal_features: pd.DataFrame of seasonal features.
         iteration: Int sampling iteration to use parameters from.
         iteration: Int sampling iteration to use parameters from.
+        s_a: Indicator vector for additive components
+        s_m: Indicator vector for multiplicative components
 
 
         Returns
         Returns
         -------
         -------

+ 1 - 1
python/fbprophet/plot.py

@@ -344,7 +344,7 @@ def plot_seasonality(m, name, ax=None, uncertainty=True):
     ax.xaxis.set_major_formatter(FuncFormatter(
     ax.xaxis.set_major_formatter(FuncFormatter(
         lambda x, pos=None: fmt_str.format(dt=num2date(x))))
         lambda x, pos=None: fmt_str.format(dt=num2date(x))))
     ax.set_xlabel('ds')
     ax.set_xlabel('ds')
-    ax.set_ylabel('{}'.format(name))
+    ax.set_ylabel(name)
     if m.seasonalities[name]['mode'] == 'multiplicative':
     if m.seasonalities[name]['mode'] == 'multiplicative':
         ax = set_y_as_percent(ax)
         ax = set_y_as_percent(ax)
     return artists
     return artists