pkg/R/computeForecast.R

   1 #' Compute forecast
   2 #'
   3 #' Predict time-series curves ("today" from predict_from to horizon) at the selected days
   4 #' indices ("today" from 1am to predict_from-1). This function just runs a loop over all
   5 #' requested indices, and stores the individual forecasts into a Forecast object.
   6 #' Note: in training stage ts_hat(day+1) = f(ts(day), exo(day+1)),
   7 #' and in production ts_hat(day+1) = f(ts(day), exo_hat(day+1))
   8 #'
   9 #' @param data Object of class Data, output of \code{getData()}.
  10 #' @param indices Indices where to forecast (the day after); integers relative to the
  11 #'   beginning of data, or (convertible to) Date objects.
  12 #' @param forecaster Name of the main forecaster; more details: ?F_<forecastername>
  13 #'   \itemize{
  14 #'     \item Persistence : use last (similar) day
  15 #'     \item Neighbors : weighted similar days
  16 #'     \item Average : average curve of all same day-in-week
  17 #'     \item Zero : just output 0 (benchmarking purpose)
  18 #'   }
  19 #' @param pjump Function to predict the jump at the interface between two days;
  20 #'   more details: ?J_<functionname>
  21 #'   \itemize{
  22 #'     \item Persistence : use last (similar) day
  23 #'     \item Neighbors: re-use the weights from F_Neighbors
  24 #'     \item LastValue: start serie with last observed value
  25 #'     \item Zero: no adjustment => use shape prediction only
  26 #'   }
  27 #' @param predict_from First time step to predict.
  28 #' @param memory Data depth (in days) to be used for prediction.
  29 #' @param horizon Last time step to predict.
  30 #' @param ncores Number of cores for parallel execution (1 to disable).
  31 #' @param verbose TRUE to print basic traces (runs beginnings)
  32 #' @param ... Additional parameters for the forecasting models.
  33 #'
  34 #' @return An object of class Forecast
  35 #'
  36 #' @examples
  37 #' ts_data <- system.file("extdata","intraday_measures.csv",package="talweg")
  38 #' exo_data <- system.file("extdata","daily_exogenous.csv",package="talweg")
  39 #' data <- getData(ts_data, exo_data, date_format="%Y-%m-%d %H:%M:%S", limit=200)
  40 #' pred <- computeForecast(data, 100:130, "Persistence", "LastValue",
  41 #'   predict_from=8, memory=50, horizon=12, ncores=1)
  42 #' \dontrun{
  43 #' #Sketch for real-time mode:
  44 #' data <- Data$new()
  45 #' forecaster <- MyForecaster$new(myJumpPredictFunc)
  46 #' repeat {
  47 #'   # As soon as daily predictions are available:
  48 #'   data$append(
  49 #'     level_hat=predicted_level,
  50 #'     exo_hat=predicted_exogenous)
  51 #'   # When a day ends:
  52 #'   data$append(
  53 #'     level=observed_level,
  54 #'     exo=observed_exogenous)
  55 #'   # And, at every hour:
  56 #'   data$append(
  57 #'     time=current_hour,
  58 #'     value=current_PM10)
  59 #'   # Finally, a bit before predict_from hour:
  60 #'   pred <- forecaster$predictSerie(data, data$getSize(), ...)
  61 #'   #do_something_with_pred
  62 #' } }
  63 #' @export
  64 computeForecast = function(data, indices, forecaster, pjump, predict_from,
  65     memory=Inf, horizon=length(data$getSerie(1)), ncores=3, verbose=FALSE, ...)
  66 {
  67     # (basic) Arguments sanity checks
  68     predict_from = as.integer(predict_from)[1]
  69     if (! predict_from %in% 1:length(data$getSerie(1)))
  70         stop("predict_from in [1,24] (hours)")
  71     if (hasArg("opera") && !list(...)$opera && memory < Inf)
  72         memory <- Inf #finite memory in training mode makes no sense
  73     horizon = as.integer(horizon)[1]
  74     if (horizon<=predict_from || horizon>length(data$getSerie(1)))
  75         stop("Horizon in [predict_from+1,24] (hours)")
  76     integer_indices = sapply(indices, function(i) dateIndexToInteger(i,data))
  77     if (any(integer_indices<=0 | integer_indices>data$getSize()))
  78         stop("Indices out of range")
  79     if (!is.character(forecaster))
  80         stop("forecaster (name): character")
  81     if (!is.character(pjump))
  82         stop("pjump (function): character")
  83
  84     pred = Forecast$new( sapply(indices, function(i) integerIndexToDate(i,data)) )
  85     forecaster_class_name = getFromNamespace(
  86         paste(forecaster,"Forecaster",sep=""), "talweg")
  87
  88     pjump <- getFromNamespace(paste("get",pjump,"JumpPredict",sep=""), "talweg")
  89     forecaster = forecaster_class_name$new(pjump)
  90
  91     computeOneForecast <- function(i)
  92     {
  93         if (verbose)
  94             print(paste("Index",i))
  95         list(
  96             "forecast" = forecaster$predictSerie(data,i,memory,predict_from,horizon,...),
  97             "params" = forecaster$getParameters(),
  98             "index" = i )
  99     }
 100
 101     p <-
 102         if (ncores > 1 && requireNamespace("parallel",quietly=TRUE))
 103             parallel::mclapply(integer_indices, computeOneForecast, mc.cores=ncores)
 104         else
 105             lapply(integer_indices, computeOneForecast)
 106
 107     # TODO: find a way to fill pred in //...
 108     for (i in seq_along(integer_indices))
 109     {
 110         pred$append(
 111             forecast = p[[i]]$forecast,
 112             params = p[[i]]$params,
 113             index_in_data = p[[i]]$index
 114         )
 115     }
 116     pred
 117 }