From: Benjamin Auder Date: Thu, 6 Apr 2017 16:14:41 +0000 (+0200) Subject: on the way back without realtime X-Git-Url: https://git.auder.net/%7B%7B%20asset%28%27mixstore/images/assets/doc/current/%7B%7B%20pkg.url%20%7D%7D?a=commitdiff_plain;h=2057c793ad9929ed5bef8663ea28b896c84df0fc;p=talweg.git on the way back without realtime --- diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index b1697df..a897984 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -2,7 +2,7 @@ Package: talweg Title: Time-Series Samples Forecasted With Exogenous Variables Version: 0.1-0 Description: Forecast a curve sampled within the day (seconds, minutes, - hours...), using past measured curves + paste exogenous informations, which + hours...), using past measured curves + past exogenous informations, which could be some aggregated measure on the past curves, the weather... Main starting point: computeForecast(). Author: Benjamin Auder [aut,cre], @@ -23,8 +23,8 @@ Suggests: LazyData: yes URL: http://git.auder.net/?p=talweg.git License: MIT + file LICENSE -RoxygenNote: 6.0.1 -Collate: +RoxygenNote: 5.0.1 +Collate: 'A_NAMESPACE.R' 'Data.R' 'Forecaster.R' diff --git a/pkg/R/A_NAMESPACE.R b/pkg/R/A_NAMESPACE.R index 4558e59..bcd5df1 100644 --- a/pkg/R/A_NAMESPACE.R +++ b/pkg/R/A_NAMESPACE.R @@ -1,3 +1,7 @@ +#' @include Data.R +#' @include Forecast.R +#' @include Forecaster.R +#' #' @importFrom grDevices colors gray.colors #' @importFrom graphics abline hist par plot #' @importFrom methods hasArg is diff --git a/pkg/R/Data.R b/pkg/R/Data.R index 551cfaf..53a8d5b 100644 --- a/pkg/R/Data.R +++ b/pkg/R/Data.R @@ -5,12 +5,14 @@ #' @docType class #' @importFrom R6 R6Class #' -#' @field .data List of \itemize{ +#' @field .data List of +#' \itemize{ #' \item time: vector of times -#' \item serie: centered series +#' \item centered_serie: centered series #' \item level: corresponding levels #' \item exo: exogenous variables -#' \item exo_hat: predicted exogenous variables} +#' \item exo_hat: predicted exogenous variables +#' } #' #' @section Methods: #' \describe{ @@ -18,24 +20,30 @@ #' Return number of series in dataset.} #' \item{\code{getStdHorizon()}}{ #' Return number of time steps from serie[1] until midnight} -#' \item{\code{appendHat(time, hat_serie, hat_exo)}}{ -#' New estimated data + time.} +#' \item{\code{appendHat(time, exo_hat)}}{ +#' New estimated exogenous variables + time} #' \item{\code{append(serie, exo)}}{ #' New measured data; call *after* \code{appendHat()}} #' \item{\code{getTime(index)}}{ #' Get times at specified index.} -#' \item{\code{getCenteredSerie(index, hat=FALSE)}}{ +#' \item{\code{getCenteredSerie(index)}}{ #' Get (measured or predicted) centered serie at specified index.} -#' \item{\code{getCenteredSeries(indices, hat=FALSE)}}{ +#' \item{\code{getCenteredSeries(indices)}}{ #' Get centered series at specified indices (in columns).} -#' \item{\code{getLevel(index, hat=FALSE)}}{ +#' \item{\code{getLevel(index)}}{ #' Get level at specified index.} -#' \item{\code{getSerie(index, hat=FALSE)}}{ +#' \item{\code{getSerie(index)}}{ #' Get serie (centered+level) at specified index.} -#' \item{\code{getSeries(indices, hat=FALSE)}}{ +#' \item{\code{getSeries(indices)}}{ #' Get series at specified indices (in columns).} -#' \item{\code{getExo(index, hat=FALSE)}}{ +#' \item{\code{getExoHat(index)}}{ +#' Get predicted exogenous variables at specified index.} +#' \item{\code{getExo(index)}}{ #' Get exogenous variables at specified index.} +#' \item{\code{removeFirst()}}{ +#' Remove first list element (if truncated).} +#' \item{\code{removeLast()}}{ +#' Remove last list element (if truncated).} #' } #' Data = R6::R6Class("Data", @@ -49,64 +57,54 @@ Data = R6::R6Class("Data", getStdHorizon = function() 24 - as.POSIXlt( private$.data[[1]]$time[1] )$hour + 1 , - appendHat = function(time, hat_serie, hat_exo) - { - hat_level = mean(hat_serie, na.rm=TRUE) - hat_centered_serie = hat_serie - hat_level - private$.data[[length(private$.data)+1]] <- list( - "time"=time, "hat_centered_serie"=hat_centered_serie, - "hat_level"=hat_level, "hat_exo"=hat_exo ) - }, - append = function(serie, exo) + appendHat = function(time, exo_hat) + private$.data[[length(private$.data)+1]] <- list("time"=time,"exo_hat"=exo_hat) + , + append = function(time, serie, exo) { + index <- length(private$.data) level = mean(serie, na.rm=TRUE) centered_serie = serie - level - private$.data[[length(private$.data)]]$centered_serie <- centered_serie, - private$.data[[length(private$.data)]]$level <- level, - private$.data[[length(private$.data)]]$exo <- exo, + private$.data[[index]]$time <- time + private$.data[[index]]$centered_serie <- centered_serie + private$.data[[index]]$level <- level + private$.data[[index]]$exo <- exo }, getTime = function(index) { index = dateIndexToInteger(index, self) private$.data[[index]]$time }, - getCenteredSerie = function(index, hat=FALSE) + getCenteredSerie = function(index) { index = dateIndexToInteger(index, self) - if (hat) - private$.data[[index]]$hat_centered_serie - else - private$.data[[index]]$centered_serie + private$.data[[index]]$centered_serie }, - getCenteredSeries = function(indices, hat=FALSE) - sapply(indices, function(i) self$getCenteredSerie(i, hat)) + getCenteredSeries = function(indices) + sapply(indices, function(i) self$getCenteredSerie(i)) , - getLevel = function(index, hat=FALSE) + getLevel = function(index) { index = dateIndexToInteger(index, self) - if (hat) - private$.data[[index]]$hat_level - else - private$.data[[index]]$level + private$.data[[index]]$level }, - getSerie = function(index, hat=FALSE) + getSerie = function(index) { index = dateIndexToInteger(index, self) - if (hat) - private$.data[[index]]$hat_centered_serie + private$.data[[index]]$hat_level - else - private$.data[[index]]$centered_serie + private$.data[[index]]$level + private$.data[[index]]$centered_serie + private$.data[[index]]$level }, - getSeries = function(indices, hat=FALSE) - sapply(indices, function(i) self$getSerie(i, hat)) + getSeries = function(indices) + sapply(indices, function(i) self$getSerie(i)) , - getExo = function(index, hat=FALSE) + getExoHat = function(index) + { + index = dateIndexToInteger(index, self) + private$.data[[index]]$exo_hat + }, + getExo = function(index) { index = dateIndexToInteger(index, self) - if (hat) - private$.data[[index]]$hat_exo - else - private$.data[[index]]$exo + private$.data[[index]]$exo }, removeFirst = function() private$.data <- private$.data[2:length(private$.data)] diff --git a/pkg/R/F_Average.R b/pkg/R/F_Average.R index c28125e..a5e3c3e 100644 --- a/pkg/R/F_Average.R +++ b/pkg/R/F_Average.R @@ -1,10 +1,9 @@ -#' @include Forecaster.R -#' #' Average Forecaster #' #' Return the (pointwise) average of the all the (similar) centered day curves #' in the past. Inherits \code{\link{Forecaster}} #' +#' @export AverageForecaster = R6::R6Class("AverageForecaster", inherit = Forecaster, diff --git a/pkg/R/F_Neighbors.R b/pkg/R/F_Neighbors.R index c9eda05..52c2b35 100644 --- a/pkg/R/F_Neighbors.R +++ b/pkg/R/F_Neighbors.R @@ -1,5 +1,3 @@ -#' @include Forecaster.R -#' #' Neighbors Forecaster #' #' Predict tomorrow as a weighted combination of "futures of the past" days. @@ -125,7 +123,7 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", private$.params$indices <- fdays private$.params$window <- 1 } - return ( data$getSerie(fdays[1])[1:horizon] ) #what else?! + return ( data$getSerie(fdays[1])[1:horizon] ) } } else diff --git a/pkg/R/F_Persistence.R b/pkg/R/F_Persistence.R index 79cfe3c..ad83449 100644 --- a/pkg/R/F_Persistence.R +++ b/pkg/R/F_Persistence.R @@ -1,5 +1,3 @@ -#' @include Forecaster.R -#' #' Persistence Forecaster #' #' Return the last centered (similar) day curve. @@ -14,14 +12,12 @@ PersistenceForecaster = R6::R6Class("PersistenceForecaster", # Return centered last (similar) day curve, avoiding NAs until memory is run first_day = max(1, today-memory) same_day = ifelse(hasArg("same_day"), list(...)$same_day, TRUE) - realtime = ifelse(hasArg("realtime"), list(...)$realtime, FALSE) # If 'same_day', get the last known future of similar day: -7 + 1 == -6 index = today - ifelse(same_day,6,0) repeat { { - last_serie = - data$getCenteredSerie(index,hat=(index==today && realtime))[1:horizon] + last_serie = data$getCenteredSerie(index)[1:horizon] index = index - ifelse(same_day,7,1) }; if (!any(is.na(last_serie))) diff --git a/pkg/R/F_Zero.R b/pkg/R/F_Zero.R index f5d6b89..ac970c4 100644 --- a/pkg/R/F_Zero.R +++ b/pkg/R/F_Zero.R @@ -1,5 +1,3 @@ -#' @include Forecaster.R -#' #' Zero Forecaster #' #' Return 0 (and then adjust). Inherits \code{\link{Forecaster}} @@ -9,6 +7,6 @@ ZeroForecaster = R6::R6Class("ZeroForecaster", public = list( predictShape = function(data, today, memory, horizon, ...) - rep(0., horizon) + rep(0, horizon) ) ) diff --git a/pkg/R/J_Neighbors.R b/pkg/R/J_Neighbors.R index 351fbf9..12fc9d4 100644 --- a/pkg/R/J_Neighbors.R +++ b/pkg/R/J_Neighbors.R @@ -9,13 +9,12 @@ getNeighborsJumpPredict = function(data, today, memory, horizon, params, ...) filter = (params$indices >= first_day) indices = params$indices[filter] weights = params$weights[filter] - realtime = ifelse(hasArg("realtime"), list(...)$realtime, FALSE) if (any(is.na(weights) | is.na(indices))) return (NA) gaps = sapply(indices, function(i) { - data$getSerie(i+1,hat=(realtime && i+1==today))[1] - tail(data$getSerie(i), 1) + head( data$getSerie(i+1), 1) - tail( data$getSerie(i), 1) }) scal_product = weights * gaps norm_fact = sum( weights[!is.na(scal_product)] ) diff --git a/pkg/R/J_Persistence.R b/pkg/R/J_Persistence.R index 4d3abd2..a85a42a 100644 --- a/pkg/R/J_Persistence.R +++ b/pkg/R/J_Persistence.R @@ -8,13 +8,12 @@ getPersistenceJumpPredict = function(data, today, memory, horizon, params, ...) #return gap between end of similar day curve and first day of tomorrow (in the past) first_day = max(1, today-memory) same_day = ifelse(hasArg("same_day"), list(...)$same_day, TRUE) - realtime = ifelse(hasArg("realtime"), list(...)$realtime, FALSE) index = today - ifelse(same_day,7,1) repeat { { last_serie_end = tail( data$getSerie(index), 1) - last_tomorrow_begin = data$getSerie(index+1,hat=(realtime && index+1==today))[1] + last_tomorrow_begin = head( data$getSerie(index+1), 1) index = index - ifelse(same_day,7,1) }; if (!is.na(last_serie_end) && !is.na(last_tomorrow_begin)) diff --git a/pkg/R/computeError.R b/pkg/R/computeError.R index ce05fdb..7da1032 100644 --- a/pkg/R/computeError.R +++ b/pkg/R/computeError.R @@ -4,7 +4,8 @@ #' #' @param data Dataset, object of class \code{Data} output of \code{getData} #' @param pred Forecast object, class \code{Forecast} output of \code{computeForecast} -#' @param horizon Horizon where to compute the error (<= horizon used in \code{computeForecast}) +#' @param horizon Horizon where to compute the error +#' (<= horizon used in \code{computeForecast}) #' #' @return A list (abs,MAPE) of lists (day,indices) #' diff --git a/pkg/R/computeForecast.R b/pkg/R/computeForecast.R index 198f6ec..1e79118 100644 --- a/pkg/R/computeForecast.R +++ b/pkg/R/computeForecast.R @@ -2,8 +2,9 @@ #' #' 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) +#' @param data Object of type \code{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 forcaster #' \itemize{ #' \item Persistence : use values of last (similar, next) day @@ -20,8 +21,7 @@ #' @param memory Data depth (in days) to be used for prediction #' @param horizon Number of time steps to predict #' @param ncores Number of cores for parallel execution (1 to disable) -#' @param ... Additional parameters for the forecasting models; -#' In particular, realtime=TRUE to use predictions instead of measurements +#' @param ... Additional parameters for the forecasting models #' #' @return An object of class Forecast #' diff --git a/pkg/R/getData.R b/pkg/R/getData.R index b944dfb..b095d01 100644 --- a/pkg/R/getData.R +++ b/pkg/R/getData.R @@ -71,12 +71,10 @@ getData = function(ts_data, exo_data, input_tz="GMT", date_format="%d/%m/%Y %H:% { time = c() serie = c() - hat_serie = c() repeat { { time = c(time, ts_df[line,1]) - hat_serie = c(serie, ts_df[line,3]) serie = c(serie, ts_df[line,2]) line = line + 1 }; @@ -89,7 +87,7 @@ getData = function(ts_data, exo_data, input_tz="GMT", date_format="%d/%m/%Y %H:% hat_exo = as.data.frame( exo_df[i,(1+nb_exos+1):(1+2*nb_exos)] ) exo = as.data.frame( exo_df[i,2:(1+nb_exos)] ) - data$appendHat(time, hat_serie, hat_exo) + data$appendHat(time, hat_exo) data$append(serie, exo) #in realtime, this call comes hours later if (i >= limit) break