"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "R/R/plot.R" between
prophet-0.7.tar.gz and prophet-1.0.tar.gz

About: Prophet 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

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)