X-Git-Url: https://git.auder.net/?p=talweg.git;a=blobdiff_plain;f=pkg%2FR%2FcomputeForecast.R;h=3537e8a8c2ba090b46989a3aafc88605f2840682;hp=1a7d8bac78f80ddb6b6e68109291a41cc52e81ed;hb=5e838b3e17465c376ca075b766cf2543c82e9864;hpb=99f83c9af27492f6fb9b10f51fb8704ed588f5c1 diff --git a/pkg/R/computeForecast.R b/pkg/R/computeForecast.R index 1a7d8ba..3537e8a 100644 --- a/pkg/R/computeForecast.R +++ b/pkg/R/computeForecast.R @@ -1,6 +1,6 @@ -#' @title get Forecast +#' Compute forecast #' -#' @description Predict time-series curves for the selected days indices (lines in data). +#' Predict time-series curves for the selected days indices (lines in data). #' #' @param data Dataset, object of type \code{Data} output of \code{getData} #' @param indices Days indices where to forecast (the day after) @@ -38,35 +38,45 @@ #' #do_something_with_pred #' }} #' @export -computeForecast = function(data, indices, forecaster, pjump=NULL, +computeForecast = function(data, indices, forecaster, pjump, memory=Inf, horizon=data$getStdHorizon(), ...) { # (basic) Arguments sanity checks horizon = as.integer(horizon)[1] if (horizon<=0 || horizon>length(data$getCenteredSerie(2))) stop("Horizon too short or too long") - indices = sapply( seq_along(indices), function(i) dateIndexToInteger(indices[i], data) ) - if (any(indices<=0 | indices>data$getSize())) + integer_indices = sapply(indices, function(i) dateIndexToInteger(i,data)) + if (any(integer_indices<=0 | integer_indices>data$getSize())) stop("Indices out of range") - indices = sapply(indices, dateIndexToInteger, data) - if (!is.character(forecaster)) - stop("forecaster (name) should be of class character") #pjump could be NULL + if (!is.character(forecaster) || !is.character(pjump)) + stop("forecaster (name) and pjump (function) should be of class character") - pred = list() - forecaster = new(paste(forecaster,"Forecaster",sep=""), data=data, - pjump = - if (is.null(pjump)) - function() {} - else - getFromNamespace(paste("get",pjump,"JumpPredict",sep=""), "talweg")) - for (today in indices) - { - #pred$append(...) is slow; TODO: use R6 class - pred[[length(pred)+1]] = list( - "serie" = forecaster$predict(today, memory, horizon, ...), - "params" = forecaster$getParameters(), - "index" = today - ) - } - new("Forecast",pred=pred) + pred = Forecast$new( sapply(indices, function(i) integerIndexToDate(i,data)) ) + forecaster_class_name = getFromNamespace(paste(forecaster,"Forecaster",sep=""), "talweg") + forecaster = forecaster_class_name$new( #.pjump = + getFromNamespace(paste("get",pjump,"JumpPredict",sep=""), "talweg")) + +#oo = forecaster$predictSerie(data, integer_indices[1], memory, horizon, ...) +#browser() + + library(parallel) + ppp <- 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=3) + +#browser() + +for (i in seq_along(integer_indices)) +{ + pred$append( + new_serie = ppp[[i]]$forecast, + new_params = ppp[[i]]$params, + new_index_in_data = ppp[[i]]$index + ) +} + + pred }