X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2FcomputeForecast.R;h=ef46dd3b7f516c23ef91430a923652224c924e1f;hb=638f27f4296727aff62b56643beb9f42aa5b57ef;hp=35372b3f10302bc32a2cf32e901d895b5b015651;hpb=e169b5d568110a86282877de4fc44384dc6d6cb0;p=talweg.git diff --git a/pkg/R/computeForecast.R b/pkg/R/computeForecast.R index 35372b3..ef46dd3 100644 --- a/pkg/R/computeForecast.R +++ b/pkg/R/computeForecast.R @@ -1,8 +1,10 @@ #' Compute forecast #' -#' Predict time-series curves for the selected days indices (lines in data). +#' Predict time-series curves ("tomorrows") at the selected days indices ("todays"). +#' This function just runs a loop over all requested indices, and stores the individual +#' forecasts into a list which is then turned into a Forecast object. #' -#' @param data Object of type \code{Data}, output of \code{getData()}. +#' @param data Object of class Data, output of \code{getData()}. #' @param indices Indices where to forecast (the day after); integers relative to the #' beginning of data, or (convertible to) Date objects. #' @param forecaster Name of the main forecaster; more details: ?F_ @@ -29,34 +31,36 @@ #' @examples #' ts_data <- system.file("extdata","pm10_mesures_H_loc.csv",package="talweg") #' exo_data <- system.file("extdata","meteo_extra_noNAs.csv",package="talweg") -#' data <- getData(ts_data, exo_data, input_tz="GMT", working_tz="GMT", predict_at=7) -#' pred <- computeForecast(data, 2200:2230, "Persistence", "Zero", -#' memory=500, horizon=12, ncores=1) +#' data <- getData(ts_data, exo_data, input_tz="GMT", working_tz="GMT", +#' predict_at=7, limit=200) +#' pred <- computeForecast(data, 100:130, "Persistence", "Zero", +#' memory=50, horizon=12, ncores=1) #' \dontrun{#Sketch for real-time mode: #' data <- Data$new() -#' # Initialize: first day has no predictions attached -#' data$initialize() #' forecaster <- MyForecaster$new(myJumpPredictFunc) #' repeat { -#' # During the night between days j and j+1: -#' data$appendExoHat(exogenous_predictions) #' # In the morning 7am+ or afternoon 1pm+: -#' data$setMeasures( -#' data$getSize()-1, +#' data$append( #' times_from_H+1_yersteday_to_Hnow, #' PM10_values_of_last_24h, -#' exogenous_measures_for_yersteday) -#' pred <- forecaster$predictSerie(data, data$getSize()-1, ...) +#' exogenous_measures_of_last_24h, +#' exogenous_predictions_for_next_24h) +#' pred <- forecaster$predictSerie(data, data$getSize(), ...) #' #do_something_with_pred #' }} #' @export -computeForecast = function(data, indices, forecaster, pjump, - memory=Inf, horizon=data$getStdHorizon(), ncores=3, ...) +computeForecast = function(data, indices, forecaster, pjump, predict_from, + memory=Inf, horizon=length(data$getSerie(1)), ncores=3, ...) { # (basic) Arguments sanity checks + predict_from = as.integer(predict_from)[1] + if (! predict_from %in% 1:length(data$getSerie(1))) + stop("predict_from in [1,24] (hours)") + if (hasArg("opera") && !list(...)$opera && memory < Inf) + memory <- Inf #finite memory in training mode makes no sense horizon = as.integer(horizon)[1] - if (horizon<=0 || horizon>length(data$getCenteredSerie(1))) - stop("Horizon too short or too long") + if (horizon<=predict_from || horizon>length(data$getSerie(1))) + stop("Horizon in [predict_from+1,24] (hours)") integer_indices = sapply(indices, function(i) dateIndexToInteger(i,data)) if (any(integer_indices<=0 | integer_indices>data$getSize())) stop("Indices out of range") @@ -69,27 +73,20 @@ computeForecast = function(data, indices, forecaster, pjump, forecaster = forecaster_class_name$new( #.pjump = getFromNamespace(paste("get",pjump,"JumpPredict",sep=""), "talweg")) - if (ncores > 1 && requireNamespace("parallel",quietly=TRUE)) + computeOneForecast <- function(i) { - p <- parallel::mclapply(seq_along(integer_indices), function(i) { - list( - "forecast" = forecaster$predictSerie( - data, integer_indices[i], memory, horizon, ...), - "params"= forecaster$getParameters(), - "index" = integer_indices[i] ) - }, mc.cores=ncores) - } - else - { - p <- lapply(seq_along(integer_indices), function(i) { - list( - "forecast" = forecaster$predictSerie( - data, integer_indices[i], memory, horizon, ...), - "params"= forecaster$getParameters(), - "index" = integer_indices[i] ) - }) + list( + "forecast" = forecaster$predictSerie(data,i,memory,predict_from,horizon,...), + "params" = forecaster$getParameters(), + "index" = i ) } + p <- + if (ncores > 1 && requireNamespace("parallel",quietly=TRUE)) + parallel::mclapply(integer_indices, computeOneForecast, mc.cores=ncores) + else + lapply(integer_indices, computeOneForecast) + # TODO: find a way to fill pred in //... for (i in seq_along(integer_indices)) {