X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2FF_Average.R;h=bee1974540341e0b20cc03f5de3aeec7bd79f54d;hb=638f27f4296727aff62b56643beb9f42aa5b57ef;hp=ba0f0036441fd8c9c402d263169d3e36053cc1fc;hpb=44a9990b6d608ffcd2e99d5193fa8b9e6cbdb436;p=talweg.git diff --git a/pkg/R/F_Average.R b/pkg/R/F_Average.R index ba0f003..bee1974 100644 --- a/pkg/R/F_Average.R +++ b/pkg/R/F_Average.R @@ -1,53 +1,57 @@ -#' @include Forecaster.R +#' Average Forecaster #' -#' @title Average Forecaster +#' Pointwise average of all the series of the same day of week in the past. #' -#' @description Return the (pointwise) average of the all the (similar) centered day curves -#' in the past. Inherits \code{\link{Forecaster}} -AverageForecaster = setRefClass( - Class = "AverageForecaster", - contains = "Forecaster", +#' For example, if the current day (argument "today") is a tuesday, then all series +#' corresponding to wednesdays in the past (until the beginning or memory limit) are +#' averaged to provide a smooth prediction. This forecast will most of the time be wrong, +#' but will also look plausible enough. +#' +#' @usage # AverageForecaster$new(pjump) +#' +#' @docType class +#' @format R6 class, inherits Forecaster +#' @aliases F_Average +#' +AverageForecaster = R6::R6Class("AverageForecaster", + inherit = Forecaster, - methods = list( - initialize = function(...) + public = list( + predictShape = function(data, today, memory, predict_from, horizon, ...) { - callSuper(...) - }, - predict = function(today, memory, horizon, ...) - { - predicted_shape = predictShape(today, memory, horizon, ...) - #Take care of never passing same_day==FALSE (when pjump == Persistence) - predicted_delta = - if (#as.character(substitute(pjump))=="Persistence" && #TODO: doesn't work - hasArg("same_day") && list(...)$same_day==FALSE) - { - args = list(...) - args$same_day = TRUE - do.call(pjump, append(list("today"=today,"memory"=memory,"horizon"=horizon), args)) - } - else - pjump(data, today, memory, horizon, params, ...) - predicted_shape + tail(data$getSerie(today),1) - predicted_shape[1] + predicted_delta - }, - predictShape = function(today, memory, horizon, ...) - { - avg = rep(0., horizon) + avg = rep(0., (horizon-predict_from+1)) first_day = max(1, today-memory) - index = today-7 + 1 + index <- today nb_no_na_series = 0 + opera = ifelse(hasArg("opera"), list(...)$opera, FALSE) repeat { - { - serie_on_horizon = data$getCenteredSerie(index)[1:horizon] - index = index - 7 - }; + index = index - 7 + if (index < first_day) + break + serie_on_horizon = data$getCenteredSerie(index)[predict_from:horizon] if (!any(is.na(serie_on_horizon))) { avg = avg + serie_on_horizon nb_no_na_series = nb_no_na_series + 1 - }; - if (index < first_day) - break + } + } + if (!opera) + { + # The same, in the future + index <- today + repeat + { + index = index + 7 + if (index > data$getSize()) + break + serie_on_horizon = data$getCenteredSerie(index)[predict_from:horizon] + if (!any(is.na(serie_on_horizon))) + { + avg = avg + serie_on_horizon + nb_no_na_series = nb_no_na_series + 1 + } + } } avg / nb_no_na_series }