Prophet Code showing Issue with Logistic Growth with MCMC sampling

linear_growth.R

H <-  365*2

# READ IN to_share.csv here
full_model <- read.csv("to_share.csv")

m <- prophet(
  yearly.seasonality = "auto",
  weekly.seasonality = F,
  daily.seasonality = "auto",
  changepoint.range = 0.8,
  changepoint.prior.scale = 0.1,
  interval.width = 0.95
)
m <- add_regressor(m, "flag1")
m <- add_regressor(m, "flag2")
m <- add_seasonality(m, "week", period = 7, fourier.order = 3, prior.scale = 20)

m <- fit.prophet(m, full_model)

future <- make_future_dataframe(m, periods = H)
future <- data.table::as.data.table(future)
future[,floor:=0]
future[,cap:=120000]
future[,flag1:=0]
future[ds>=as.Date("2018-04-14"), flag1:=1]
future[ds>=as.Date("2019-04-01"), flag1:=2]
future[ds>=as.Date("2020-04-01"), flag1:=3]
future[ds>=as.Date("2021-04-01"), flag1:=4]
future[ds>=as.Date("2022-04-01"), flag1:=5]
future[,flag2:=0]
future[ds>=as.Date("2017-12-23") & ds<=as.Date("2018-01-01"),flag2:=1]
future[ds>=as.Date("2018-12-23") & ds<=as.Date("2019-01-01"),flag2:=1]
future[ds>=as.Date("2019-12-21") & ds<=as.Date("2020-01-01"),flag2:=1]
future[ds>=as.Date("2020-12-21") & ds<=as.Date("2021-01-01"),flag2:=1]
future[ds>=as.Date("2021-12-21") & ds<=as.Date("2022-01-01"),flag2:=1]
future <- as.data.frame(future)

fcst <- predict(m, future)

plot_prophet(x = m,  fcst = fcst, test = full_model)

logistic_growth.R

H <-  365*2

# READ IN to_share.csv here
full_model <- read.csv("to_share.csv")

m <- prophet(
  yearly.seasonality = "auto",
  weekly.seasonality = F,
  daily.seasonality = "auto",
  changepoint.range = 0.8,
  changepoint.prior.scale = 0.1,
  growth = "logistic",
  interval.width = 0.95
)
m <- add_regressor(m, "flag1")
m <- add_regressor(m, "flag2")
m <- add_seasonality(m, "week", period = 7, fourier.order = 3, prior.scale = 20)

m <- fit.prophet(m, full_model)

future <- make_future_dataframe(m, periods = H)
future <- data.table::as.data.table(future)
future[,floor:=0]
future[,cap:=120000]
future[,flag1:=0]
future[ds>=as.Date("2018-04-14"), flag1:=1]
future[ds>=as.Date("2019-04-01"), flag1:=2]
future[ds>=as.Date("2020-04-01"), flag1:=3]
future[ds>=as.Date("2021-04-01"), flag1:=4]
future[ds>=as.Date("2022-04-01"), flag1:=5]
future[,flag2:=0]
future[ds>=as.Date("2017-12-23") & ds<=as.Date("2018-01-01"),flag2:=1]
future[ds>=as.Date("2018-12-23") & ds<=as.Date("2019-01-01"),flag2:=1]
future[ds>=as.Date("2019-12-21") & ds<=as.Date("2020-01-01"),flag2:=1]
future[ds>=as.Date("2020-12-21") & ds<=as.Date("2021-01-01"),flag2:=1]
future[ds>=as.Date("2021-12-21") & ds<=as.Date("2022-01-01"),flag2:=1]
future <- as.data.frame(future)

fcst <- predict(m, future)

plot_prophet(x = m,  fcst = fcst, test = full_model)

logistic_growth_with_MCMC.R

H <-  365*2

# READ IN to_share.csv here
full_model <- read.csv("to_share.csv")

m <- prophet(
  yearly.seasonality = "auto",
  weekly.seasonality = F,
  daily.seasonality = "auto",
  changepoint.range = 0.8,
  changepoint.prior.scale = 0.1,
  growth = "logistic",
  mcmc.samples = 300,
  interval.width = 0.95
)
m <- add_regressor(m, "flag1")
m <- add_regressor(m, "flag2")
m <- add_seasonality(m, "week", period = 7, fourier.order = 3, prior.scale = 20)

m <- fit.prophet(m, full_model)

future <- make_future_dataframe(m, periods = H)
future <- data.table::as.data.table(future)
future[,floor:=0]
future[,cap:=120000]
future[,flag1:=0]
future[ds>=as.Date("2018-04-14"), flag1:=1]
future[ds>=as.Date("2019-04-01"), flag1:=2]
future[ds>=as.Date("2020-04-01"), flag1:=3]
future[ds>=as.Date("2021-04-01"), flag1:=4]
future[ds>=as.Date("2022-04-01"), flag1:=5]
future[,flag2:=0]
future[ds>=as.Date("2017-12-23") & ds<=as.Date("2018-01-01"),flag2:=1]
future[ds>=as.Date("2018-12-23") & ds<=as.Date("2019-01-01"),flag2:=1]
future[ds>=as.Date("2019-12-21") & ds<=as.Date("2020-01-01"),flag2:=1]
future[ds>=as.Date("2020-12-21") & ds<=as.Date("2021-01-01"),flag2:=1]
future[ds>=as.Date("2021-12-21") & ds<=as.Date("2022-01-01"),flag2:=1]
future <- as.data.frame(future)

fcst <- predict(m, future)

plot_prophet(x = m,  fcst = fcst, test = full_model)

prophet_plotter_using_dygraph.R

plot_prophet <- function (x, test, fcst, uncertainty = TRUE, ...) {
  forecast.label = "Predicted"
  actual.label = "Actual"
  test.label = "Test"
  df <- prophet:::df_for_plotting(x, fcst)
  test <- test %>% dplyr::select(ds, y) %>% rename(test=y)
  test$ds = as.POSIXct(test$ds,format="%Y-%m-%d")
  df <- df %>% full_join(test)
  if (uncertainty && exists("yhat_lower", where = df)) {
    colsToKeep <- c("y", "yhat", "yhat_lower", "yhat_upper", "test")
    forecastCols <- c("yhat_lower", "yhat", "yhat_upper")
  } else {
    colsToKeep <- c("y", "yhat", "test")
    forecastCols <- c("yhat")
  }
  dfTS <- xts::xts(df %>% dplyr::select_(.dots = colsToKeep), 
                   order.by = df$ds)
  dyBase <- dygraphs::dygraph(dfTS)
  presAnnotation <- function(dygraph, x, text) {
    dygraph %>% dygraphs::dyAnnotation(x, text, text, attachAtBottom = TRUE)
  }
  dyBase <- dyBase %>% dygraphs::dySeries("y", label = actual.label, 
                                          color = "black", drawPoints = TRUE, strokeWidth = .6) %>% 
    dygraphs::dySeries("test", label = test.label, color = "red", drawPoints = TRUE, strokeWidth = 1) %>% 
    dygraphs::dySeries(forecastCols, label = forecast.label, color = "blue") %>% 
    dygraphs::dyRangeSelector() %>% 
    dygraphs::dyUnzoom() %>% 
    dygraphs::dyCrosshair(direction = "vertical")
  if (!is.null(x$holidays)) {
    for (i in 1:nrow(x$holidays)) {
      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)
}