is a tool for producing high quality forecasts for time series data that has multiple seasonality with linear or non-linear growth.
| plot.R (prophet-0.7) | : | plot.R (prophet-1.0) |
|---|
| | |
| skipping to change at line 106 | | skipping to change at line 106 |
|---|
| #' Set to FALSE if you want the function to only return the list of panels. | | #' Set to FALSE if you want the function to only return the list of panels. |
| #' | | #' |
| #' @return Invisibly return a list containing the plotted ggplot objects | | #' @return Invisibly return a list containing the plotted ggplot objects |
| #' | | #' |
| #' @export | | #' @export |
| #' @importFrom dplyr "%>%" | | #' @importFrom dplyr "%>%" |
| prophet_plot_components <- function( | | prophet_plot_components <- function( |
| m, fcst, uncertainty = TRUE, plot_cap = TRUE, weekly_start = 0, | | m, fcst, uncertainty = TRUE, plot_cap = TRUE, weekly_start = 0, |
| yearly_start = 0, render_plot = TRUE | | yearly_start = 0, render_plot = TRUE |
| ) { | | ) { |
|
| | dt <- diff(time_diff(m$history$ds, m$start)) |
| | min.dt <- min(dt[dt > 0]) |
| # Plot the trend | | # Plot the trend |
| panels <- list( | | panels <- list( |
| plot_forecast_component(m, fcst, 'trend', uncertainty, plot_cap)) | | plot_forecast_component(m, fcst, 'trend', uncertainty, plot_cap)) |
| # Plot holiday components, if present. | | # Plot holiday components, if present. |
| if (!is.null(m$train.holiday.names) && ('holidays' %in% colnames(fcst))) { | | if (!is.null(m$train.holiday.names) && ('holidays' %in% colnames(fcst))) { |
| panels[[length(panels) + 1]] <- plot_forecast_component( | | panels[[length(panels) + 1]] <- plot_forecast_component( |
| m, 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)) { |
|
| panels[[length(panels) + 1]] <- plot_weekly(m, uncertainty, weekly_start) | | if (min.dt < 1) { |
| | panels[[length(panels) + 1]] <- plot_seasonality(m, 'weekly', uncertainty) |
| | } else { |
| | panels[[length(panels) + 1]] <- plot_weekly(m, uncertainty, weekly_start) |
| | } |
| } | | } |
| # Plot yearly seasonality, if present | | # Plot yearly seasonality, if present |
| if ("yearly" %in% colnames(fcst)) { | | if ("yearly" %in% colnames(fcst)) { |
| panels[[length(panels) + 1]] <- plot_yearly(m, uncertainty, yearly_start) | | panels[[length(panels) + 1]] <- plot_yearly(m, uncertainty, yearly_start) |
| } | | } |
| # Plot other seasonalities | | # Plot other seasonalities |
| for (name in sort(names(m$seasonalities))) { | | for (name in sort(names(m$seasonalities))) { |
| if (!(name %in% c('weekly', 'yearly')) && | | if (!(name %in% c('weekly', 'yearly')) && |
| (name %in% colnames(fcst))) { | | (name %in% colnames(fcst))) { |
| if (m$seasonalities[[name]]$period == 7) { | | if (m$seasonalities[[name]]$period == 7) { |
| | |
| skipping to change at line 180 | | skipping to change at line 186 |
|---|
| #' only be done if m$uncertainty.samples > 0. | | #' only be done if m$uncertainty.samples > 0. |
| #' @param plot_cap Boolean indicating if the capacity should be shown in the | | #' @param plot_cap Boolean indicating if the capacity should be shown in the |
| #' figure, if available. | | #' figure, if available. |
| #' | | #' |
| #' @return A ggplot2 plot. | | #' @return A ggplot2 plot. |
| #' | | #' |
| #' @export | | #' @export |
| plot_forecast_component <- function( | | plot_forecast_component <- function( |
| m, fcst, name, uncertainty = TRUE, plot_cap = FALSE | | m, fcst, name, uncertainty = TRUE, plot_cap = FALSE |
| ) { | | ) { |
|
| | |
| | wrapped.name <- paste0("`", name, "`") |
| | |
| | lower.name <- paste0(name, '_lower') |
| | lower.name <- paste0("`", lower.name, "`") |
| | |
| | upper.name <- paste0(name, '_upper') |
| | upper.name <- paste0("`", upper.name, "`") |
| | |
| 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 = wrapped.name, group = 1)) + |
| ggplot2::geom_line(color = "#0072B2", na.rm = TRUE) | | ggplot2::geom_line(color = "#0072B2", na.rm = TRUE) |
| if (exists('cap', where = fcst) && plot_cap) { | | if (exists('cap', where = fcst) && plot_cap) { |
| gg.comp <- gg.comp + ggplot2::geom_line( | | gg.comp <- gg.comp + ggplot2::geom_line( |
| ggplot2::aes(y = cap), linetype = 'dashed', na.rm = TRUE) | | ggplot2::aes(y = cap), linetype = 'dashed', na.rm = TRUE) |
| } | | } |
| if (exists('floor', where = fcst) && plot_cap) { | | if (exists('floor', where = fcst) && plot_cap) { |
| gg.comp <- gg.comp + ggplot2::geom_line( | | gg.comp <- gg.comp + ggplot2::geom_line( |
| ggplot2::aes(y = floor), linetype = 'dashed', na.rm = TRUE) | | ggplot2::aes(y = floor), linetype = 'dashed', na.rm = TRUE) |
| } | | } |
| if (uncertainty && m$uncertainty.samples) { | | if (uncertainty && m$uncertainty.samples) { |
| gg.comp <- gg.comp + | | gg.comp <- gg.comp + |
| ggplot2::geom_ribbon( | | ggplot2::geom_ribbon( |
| ggplot2::aes_string( | | ggplot2::aes_string( |
|
| ymin = paste0(name, '_lower'), ymax = paste0(name, '_upper') | | ymin = lower.name, ymax = upper.name |
| ), | | ), |
| alpha = 0.2, | | alpha = 0.2, |
| fill = "#0072B2", | | fill = "#0072B2", |
| na.rm = TRUE) | | na.rm = TRUE) |
| } | | } |
| if (name %in% m$component.modes$multiplicative) { | | if (name %in% m$component.modes$multiplicative) { |
| gg.comp <- gg.comp + ggplot2::scale_y_continuous(labels = scales::percent) | | gg.comp <- gg.comp + ggplot2::scale_y_continuous(labels = scales::percent) |
| } | | } |
| return(gg.comp) | | return(gg.comp) |
| } | | } |
| | |
| skipping to change at line 342 | | skipping to change at line 357 |
|---|
| period <- m$seasonalities[[name]]$period | | period <- m$seasonalities[[name]]$period |
| end <- start + period * 24 * 3600 | | end <- start + period * 24 * 3600 |
| plot.points <- 200 | | plot.points <- 200 |
| days <- seq(from=start, to=end, length.out=plot.points) | | days <- seq(from=start, to=end, length.out=plot.points) |
| df.y <- seasonality_plot_df(m, days) | | df.y <- seasonality_plot_df(m, days) |
| seas <- predict_seasonal_components(m, df.y) | | seas <- predict_seasonal_components(m, df.y) |
| seas$ds <- df.y$ds | | seas$ds <- df.y$ds |
| gg.s <- ggplot2::ggplot( | | gg.s <- ggplot2::ggplot( |
| seas, ggplot2::aes_string(x = 'ds', y = name, group = 1)) + | | seas, ggplot2::aes_string(x = 'ds', y = name, group = 1)) + |
| ggplot2::geom_line(color = "#0072B2", na.rm = TRUE) | | ggplot2::geom_line(color = "#0072B2", na.rm = TRUE) |
|
| if (period <= 2) { | | |
| | date_breaks <- ggplot2::waiver() |
| | label <- 'ds' |
| | if (name == 'weekly') { |
| | fmt.str <- '%a' |
| | date_breaks <- '1 day' |
| | label <- 'Day of Week' |
| | } else if (name == 'daily') { |
| | fmt.str <- '%T' |
| | date_breaks <- '4 hours' |
| | label <- 'Hour of day' |
| | } else if (period <= 2) { |
| fmt.str <- '%T' | | fmt.str <- '%T' |
|
| | label <- 'Hours' |
| } else if (period < 14) { | | } else if (period < 14) { |
| fmt.str <- '%m/%d %R' | | fmt.str <- '%m/%d %R' |
| } else { | | } else { |
| fmt.str <- '%m/%d' | | fmt.str <- '%m/%d' |
| } | | } |
| gg.s <- gg.s + | | gg.s <- gg.s + |
|
| ggplot2::scale_x_datetime(labels = scales::date_format(fmt.str)) | | ggplot2::scale_x_datetime( |
| | labels = scales::date_format(fmt.str), date_breaks = date_breaks |
| | ) + |
| | ggplot2::xlab(label) |
| if (uncertainty && m$uncertainty.samples) { | | if (uncertainty && m$uncertainty.samples) { |
| gg.s <- gg.s + | | gg.s <- gg.s + |
| ggplot2::geom_ribbon( | | ggplot2::geom_ribbon( |
| ggplot2::aes_string( | | ggplot2::aes_string( |
| ymin = paste0(name, '_lower'), ymax = paste0(name, '_upper') | | ymin = paste0(name, '_lower'), ymax = paste0(name, '_upper') |
| ), | | ), |
| alpha = 0.2, | | alpha = 0.2, |
| fill = "#0072B2", | | fill = "#0072B2", |
| na.rm = TRUE) | | na.rm = TRUE) |
| } | | } |
| | | |
| End of changes. 8 change blocks. |
|---|
| 5 lines changed or deleted | | 35 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 