| 1 | #' Compute forecast |
| 2 | #' |
| 3 | #' Predict time-series curves ("tomorrows") at the selected days indices ("todays"). |
| 4 | #' This function just runs a loop over all requested indices, and stores the individual |
| 5 | #' forecasts into a list which is then turned into a Forecast object. |
| 6 | #' |
| 7 | #' @param data Object of class Data, output of \code{getData()}. |
| 8 | #' @param indices Indices where to forecast (the day after); integers relative to the |
| 9 | #' beginning of data, or (convertible to) Date objects. |
| 10 | #' @param forecaster Name of the main forecaster; more details: ?F_<forecastername> |
| 11 | #' \itemize{ |
| 12 | #' \item Persistence : use last (similar, next) day |
| 13 | #' \item Neighbors : weighted tomorrows of similar days |
| 14 | #' \item Average : average tomorrow of all same day-in-week |
| 15 | #' \item Zero : just output 0 (benchmarking purpose) |
| 16 | #' } |
| 17 | #' @param pjump Function to predict the jump at the interface between two days; |
| 18 | #' more details: ?J_<functionname> |
| 19 | #' \itemize{ |
| 20 | #' \item Persistence : use last (similar, next) day |
| 21 | #' \item Neighbors: re-use the weights from F_Neighbors |
| 22 | #' \item Zero: just output 0 (no adjustment) |
| 23 | #' } |
| 24 | #' @param memory Data depth (in days) to be used for prediction. |
| 25 | #' @param horizon Number of time steps to predict. |
| 26 | #' @param ncores Number of cores for parallel execution (1 to disable). |
| 27 | #' @param ... Additional parameters for the forecasting models. |
| 28 | #' |
| 29 | #' @return An object of class Forecast |
| 30 | #' |
| 31 | #' @examples |
| 32 | #' ts_data <- system.file("extdata","pm10_mesures_H_loc.csv",package="talweg") |
| 33 | #' exo_data <- system.file("extdata","meteo_extra_noNAs.csv",package="talweg") |
| 34 | #' data <- getData(ts_data, exo_data, input_tz="GMT", working_tz="GMT", |
| 35 | #' predict_at=7, limit=200) |
| 36 | #' pred <- computeForecast(data, 100:130, "Persistence", "Zero", |
| 37 | #' memory=50, horizon=12, ncores=1) |
| 38 | #' \dontrun{#Sketch for real-time mode: |
| 39 | #' data <- Data$new() |
| 40 | #' forecaster <- MyForecaster$new(myJumpPredictFunc) |
| 41 | #' repeat { |
| 42 | #' # In the morning 7am+ or afternoon 1pm+: |
| 43 | #' data$append( |
| 44 | #' times_from_H+1_yersteday_to_Hnow, |
| 45 | #' PM10_values_of_last_24h, |
| 46 | #' exogenous_measures_of_last_24h, |
| 47 | #' exogenous_predictions_for_next_24h) |
| 48 | #' pred <- forecaster$predictSerie(data, data$getSize(), ...) |
| 49 | #' #do_something_with_pred |
| 50 | #' }} |
| 51 | #' @export |
| 52 | computeForecast = function(data, indices, forecaster, pjump, predict_from, |
| 53 | memory=Inf, horizon=length(data$getSerie(1)), ncores=3, ...) |
| 54 | { |
| 55 | # (basic) Arguments sanity checks |
| 56 | predict_from = as.integer(predict_from)[1] |
| 57 | if (! predict_from %in% 1:length(data$getSerie(1))) |
| 58 | stop("predict_from in [1,24] (hours)") |
| 59 | horizon = as.integer(horizon)[1] |
| 60 | if (horizon<=predict_from || horizon>length(data$getSerie(1))) |
| 61 | stop("Horizon in [predict_from+1,24] (hours)") |
| 62 | integer_indices = sapply(indices, function(i) dateIndexToInteger(i,data)) |
| 63 | if (any(integer_indices<=0 | integer_indices>data$getSize())) |
| 64 | stop("Indices out of range") |
| 65 | if (!is.character(forecaster) || !is.character(pjump)) |
| 66 | stop("forecaster (name) and pjump (function) should be of class character") |
| 67 | |
| 68 | pred = Forecast$new( sapply(indices, function(i) integerIndexToDate(i,data)) ) |
| 69 | forecaster_class_name = getFromNamespace( |
| 70 | paste(forecaster,"Forecaster",sep=""), "talweg") |
| 71 | forecaster = forecaster_class_name$new( #.pjump = |
| 72 | getFromNamespace(paste("get",pjump,"JumpPredict",sep=""), "talweg")) |
| 73 | |
| 74 | computeOneForecast <- function(i) |
| 75 | { |
| 76 | list( |
| 77 | "forecast" = forecaster$predictSerie(data,i,memory,predict_from,horizon,...), |
| 78 | "params" = forecaster$getParameters(), |
| 79 | "index" = i ) |
| 80 | } |
| 81 | |
| 82 | p <- |
| 83 | if (ncores > 1 && requireNamespace("parallel",quietly=TRUE)) |
| 84 | parallel::mclapply(integer_indices, computeOneForecast, mc.cores=ncores) |
| 85 | else |
| 86 | lapply(integer_indices, computeOneForecast) |
| 87 | |
| 88 | # TODO: find a way to fill pred in //... |
| 89 | for (i in seq_along(integer_indices)) |
| 90 | { |
| 91 | pred$append( |
| 92 | forecast = p[[i]]$forecast, |
| 93 | params = p[[i]]$params, |
| 94 | index_in_data = p[[i]]$index |
| 95 | ) |
| 96 | } |
| 97 | pred |
| 98 | } |