Add custom cutoff option to R (#1484)

* Add test for custom cutoff cv

* implement custom cutoff logic in cv function

* add docstring

* add description in notebook and rebuild .Rd docs

* fix bug and add test case for period is NULL

* replace s.POSIXct set_date

R/R/diagnostics.R

@@ -53,9 +53,9 @@ generate_cutoffs <- function(df, horizon, initial, period) {
 
 #' Cross-validation for time series.
 #'
-#' Computes forecasts from historical cutoff points. Beginning from
-#' (end - horizon), works backwards making cutoffs with a spacing of period
-#' until initial is reached.
+#' Computes forecasts from historical cutoff points which user can input.If
+#' not provided, these are computed beginning from (end - horizon), and working
+#' backwards making cutoffs with a spacing of period until initial is reached.
 #'
 #' When period is equal to the time interval of the data, this is the
 #' technique described in https://robjhyndman.com/hyndsight/tscv/ .
@@ -67,50 +67,64 @@ generate_cutoffs <- function(df, horizon, initial, period) {
 #'  horizon. If not provided, 0.5 * horizon is used.
 #' @param initial Integer size of the first training period. If not provided,
 #'  3 * horizon is used. Same units as horizon.
+#' @param cutoffs Vector of cutoff dates to be used during
+#'  cross-validtation. If not provided works beginning from (end - horizon),
+#'  works backwards making cutoffs with a spacing of period until initial is
+#'  reached.
 #'
 #' @return A dataframe with the forecast, actual value, and cutoff date.
 #'
 #' @export
 cross_validation <- function(
-    model, horizon, units, period = NULL, initial = NULL) {
+    model, horizon, units, period = NULL, initial = NULL, cutoffs=NULL) {
   df <- model$history
   horizon.dt <- as.difftime(horizon, units = units)
-  # Set period
-  if (is.null(period)) {
-    period <- 0.5 * horizon
+
+  predict_columns <- c('ds', 'yhat')
+  if (model$uncertainty.samples){
+    predict_columns <- append(predict_columns, c('yhat_lower', 'yhat_upper'))
   }
-  period.dt <- as.difftime(period, units = units)
   # Identify largest seasonality period
   period.max <- 0
   for (s in model$seasonalities) {
     period.max <- max(period.max, s$period)
   }
   seasonality.dt <- as.difftime(period.max, units = 'days')
-  # Set initial
-  if (is.null(initial)) {
-    initial.dt <- max(
-      as.difftime(3 * horizon, units = units),
-      seasonality.dt
-    )
-  } else {
-    initial.dt <- as.difftime(initial, units = units)
-    if (initial.dt < seasonality.dt) {
-      warning(paste0('Seasonality has period of ', period.max, ' days which ',
-        'is larger than initial window. Consider increasing initial.'))
+
+  if (is.null(cutoffs)){
+
+    # Set period
+    if (is.null(period)) {
+      period <- 0.5 * horizon
     }
-  }
-  
-  predict_columns <- c('ds', 'yhat')
-  if (model$uncertainty.samples){
-    predict_columns <- append(predict_columns, c('yhat_lower', 'yhat_upper'))
+    period.dt <- as.difftime(period, units = units)
+    # Set initial
+    if (is.null(initial)) {
+      initial.dt <- max(
+        as.difftime(3 * horizon, units = units),
+        seasonality.dt
+      )
+    }else {
+      initial.dt <- as.difftime(initial, units = units)
+    }
+    cutoffs <- generate_cutoffs(df, horizon.dt, initial.dt, period.dt)
+  }else{
+    cutoffs <- set_date(ds=cutoffs)
+    initial.dt <- cutoffs[1] - min(df$ds)
   }
 
-  cutoffs <- generate_cutoffs(df, horizon.dt, initial.dt, period.dt)
+  # Check if the initial window  (that is, the amount of time between the
+  # start of the history and the first cutoff) is less than the
+  # maximum seasonality period
+  if (initial.dt < seasonality.dt) {
+    warning(paste0('Seasonality has period of ', period.max, ' days which ',
+      'is larger than initial window. Consider increasing initial.'))
+  }
 
   predicts <- data.frame()
   for (i in 1:length(cutoffs)) {
-    cutoff <- cutoffs[i]
     # Copy the model
+    cutoff <- cutoffs[i]
     m <- prophet_copy(model, cutoff)
     # Train model
     history.c <- dplyr::filter(df, ds <= cutoff)

R/man/cross_validation.Rd

@@ -4,7 +4,14 @@
 \alias{cross_validation}
 \title{Cross-validation for time series.}
 \usage{
-cross_validation(model, horizon, units, period = NULL, initial = NULL)
+cross_validation(
+  model,
+  horizon,
+  units,
+  period = NULL,
+  initial = NULL,
+  cutoffs = NULL
+)
 }
 \arguments{
 \item{model}{Fitted Prophet model.}
@@ -18,14 +25,19 @@ horizon. If not provided, 0.5 * horizon is used.}
 
 \item{initial}{Integer size of the first training period. If not provided,
 3 * horizon is used. Same units as horizon.}
+
+\item{cutoffs}{Vector of cutoff dates to be used during
+cross-validtation. If not provided works beginning from (end - horizon),
+works backwards making cutoffs with a spacing of period until initial is
+reached.}
 }
 \value{
 A dataframe with the forecast, actual value, and cutoff date.
 }
 \description{
-Computes forecasts from historical cutoff points. Beginning from
-(end - horizon), works backwards making cutoffs with a spacing of period
-until initial is reached.
+Computes forecasts from historical cutoff points which user can input.If
+not provided, these are computed beginning from (end - horizon), and working
+backwards making cutoffs with a spacing of period until initial is reached.
 }
 \details{
 When period is equal to the time interval of the data, this is the

R/tests/testthat/test_diagnostics.R

@@ -63,8 +63,8 @@ test_that("cross_validation_extra_regressors", {
   df$is_conditional_week <- seq(0, nrow(df) - 1) %/% 7 %% 2
   m <- prophet()
   m <- add_seasonality(m, name = 'monthly', period = 30.5, fourier.order = 5)
-  m <- add_seasonality(m, name = 'conditional_weekly', period = 7, 
-                       fourier.order = 3, prior.scale = 2., 
+  m <- add_seasonality(m, name = 'conditional_weekly', period = 7,
+                       fourier.order = 3, prior.scale = 2.,
                        condition.name = 'is_conditional_week')
   m <- add_regressor(m, 'extra')
   m <- fit.prophet(m, df)
@@ -90,6 +90,21 @@ test_that("cross_validation_default_value_check", {
   expect_equal(sum(dplyr::select(df.cv1 - df.cv2, y, yhat)), 0)
 })
 
+test_that("cross_validation_custom_cutoffs", {
+  skip_if_not(Sys.getenv('R_ARCH') != '/i386')
+  m <- prophet(DATA)
+  # When specify a list of cutoffs the cutoff dates in df.cv1
+  # are those specified
+  cutoffs=c(as.Date('2012-07-31'), as.Date('2012-08-31'))
+  df.cv <-cross_validation(
+    m, horizon = 32, units = "days", period = 10, cutoffs=cutoffs)
+  expect_equal(length(unique(df.cv$cutoff)), 2)
+  # test this works ok when periods is NULL
+  df.cv <-cross_validation(
+    m, horizon = 32, units = "days", cutoffs=cutoffs)
+  expect_equal(length(unique(df.cv$cutoff)), 2)
+})
+
 test_that("cross_validation_uncertainty_disabled", {
   skip_if_not(Sys.getenv('R_ARCH') != '/i386')
   for (uncertainty in c(0, FALSE)) {

notebooks/diagnostics.ipynb

@@ -274,6 +274,28 @@
    "source": [
     "In R, the argument `units` must be a type accepted by `as.difftime`, which is weeks or shorter. In Python, the string for `initial`, `period`, and `horizon` should be in the format used by Pandas Timedelta, which accepts units of days or shorter.\n",
     "\n",
+    "Custom cutoffs can also be supplied as a list of dates to to the `cutoffs` keyword in the `cross_validation` function in Python and R. For example, three cutoffs six months apart, would need to be passed to the `cutoffs` argument in a date format like below:\n",
+    "```python\n",
+    "#Python\n",
+    "cutoffs = [pd.Timestamp('2013-02-15'), pd.Timestamp('2013-08-15'), pd.Timestamp('2014-02-15')]\n",
+    "```\n",
+    "```r\n",
+    "#R\n",
+    "cutoffs = c(as.Date('2013-02-15'), as.Date('2013-08-15'), as.Date('2014-02-15')\n",
+    "```"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "### Cross-Validation in Parallel "
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
     "Cross-validation can also be run in parallel mode in Python, by setting specifying the `parallel` keyword. Three modes are supported\n",
     "\n",
     "* `parallel=\"processes\"`\n",