#'
#' Data encapsulation
#'
-#' @field data List of
-#' \itemize{
+#' @docType class
+#' @importFrom R6 R6Class
+#'
+#' @field .data List of \itemize{
#' \item time: vector of times
#' \item serie: centered series
#' \item level: corresponding levels
#' \item exo: exogenous variables
-#' \item exo_hat: predicted exogenous variables
-#' }
-#'
-#' @docType class
-#' @importFrom R6 R6Class
+#' \item exo_hat: predicted exogenous variables}
#'
-#' @export
+#' @section Methods: \describe{
+#' \item{\code{getSize()}}
+#' {Return number of series in dataset.}
+#' \item{\code{getStdHorizon()}}
+#' {Return number of time steps from serie[1] until midnight}
+#' \item{\code{append(new_time, new_centered_serie, new_level, new_exo, new_exo_hat)}}
+#' {Acquire a new vector of lists (time, centered_serie, level, exo, exo_hat).}
+#' \item{\code{getTime(index)}}
+#' {Get times at specified index.}
+#' \item{\code{getCenteredSerie(index)}}
+#' {Get centered serie at specified index.}
+#' \item{\code{getLevel(index)}}
+#' {Get level at specified index.}
+#' \item{\code{getSerie(index)}}
+#' {Get serie (centered+level) at specified index.}
+#' \item{\code{getExo(index)}}
+#' {Get exogenous variables at specified index.}
+#' \item{\code{getExoHat(index)}}
+#' {Get estimated exogenous variables at specified index.} }
Data = R6::R6Class("Data",
private = list(
.data = list()
),
public = list(
getSize = function()
- getSizeData(private)
+ length(private$.data)
,
getStdHorizon = function()
- getStdHorizonData(private)
- ,
- append = function(new_time, new_centered_serie, new_level, new_exo, new_exo_hat)
- appendData(private, new_time, new_centered_serie, new_level, new_exo, new_exo_hat)
+ 24 - as.POSIXlt( private$.data[[1]]$time[1] )$hour + 1
,
+ append = function(
+ {
+ private$.data[[length(private$.data)+1]] <- list(
+ "time"=new_time, "centered_serie"=new_centered_serie, "level"=new_level,
+ "exo"=new_exo, "exo_hat"=new_exo_hat)
+ },
getTime = function(index)
- getTimeData(self, private, index)
- ,
+ {
+ index = dateIndexToInteger(index, self)
+ private$.data[[index]]$time
+ },
getCenteredSerie = function(index)
- getCenteredSerieData(self, private, index)
- ,
+ {
+ index = dateIndexToInteger(index, self)
+ private$.data[[index]]$centered_serie
+ },
getLevel = function(index)
- getLevelData(self, private, index)
- ,
+ {
+ index = dateIndexToInteger(index, self)
+ private$.data[[index]]$level
+ },
getSerie = function(index)
- getSerieData(self, private, index)
- ,
+ {
+ index = dateIndexToInteger(index, self)
+ private$.data[[index]]$centered_serie + private$.data[[index]]$level
+ },
getExo = function(index)
- getExoData(self, private, index)
- ,
+ {
+ index = dateIndexToInteger(index, self)
+ private$.data[[index]]$exo
+ },
getExoHat = function(index)
- getExoHatData(self, private, index)
+ {
+ index = dateIndexToInteger(index, self)
+ private$.data[[index]]$exo_hat
+ },
+ removeFirst = function()
+ private$.data <- private$.data[2:length(private$.data)]
+ ,
+ removeLast = function()
+ private$.data <- private$.data[1:(length(private$.data)-1)]
)
)
-
-#' Number of series in the dataset
-#'
-#' @param private List of private members in current object
-getSizeData = function(private)
- length(private$.data)
-
-#' 'Standard' horizon, from t+1 to midnight
-#'
-#' @inheritParams getSizeData
-getStdHorizonData = function(private)
- 24 - as.POSIXlt( private$.data[[1]]$time[1] )$hour + 1
-
-#' Acquire a new vector of lists (time, centered_serie, level, exo, exo_hat)
-#'
-#' @inheritParams getSizeData
-#' @param new_time Time
-#' @param new_centered_serie Centered serie
-#' @param new_level Level
-#' @param new_exo Exogneous variables
-#' @param new_exo_hat Predicted exogenous variables
-appendData = function(private, new_time, new_centered_serie, new_level, new_exo, new_exo_hat)
-{
- private$.data[[length(private$.data)+1]] <- list("time"=new_time,
- "centered_serie"=new_centered_serie,"level"=new_level,"exo"=new_exo,"exo_hat"=new_exo_hat)
-}
-
-#' Time values at specified index
-#'
-#' @inheritParams getSizeData
-#' @param index Return value at this index
-getTimeData = function(o, private, index)
-{
- index = dateIndexToInteger(index, o)
- private$.data[[index]]$time
-}
-
-#' Centered serie values at specified index
-#'
-#' @inheritParams getTimeData
-getCenteredSerieData = function(o, private, index)
-{
- index = dateIndexToInteger(index, o)
- private$.data[[index]]$centered_serie
-}
-
-#' Level of the serie at specified index
-#'
-#' @inheritParams getTimeData
-getLevelData = function(o, private, index)
-{
- index = dateIndexToInteger(index, o)
- private$.data[[index]]$level
-}
-
-#' Serie values (centered+level) at specified index
-#'
-#' @inheritParams getTimeData
-getSerieData = function(o, private, index)
-{
- index = dateIndexToInteger(index, o)
- private$.data[[index]]$centered_serie + data[[index]]$level
-}
-
-#' Exogenous measures at specified index
-#'
-#' @inheritParams getTimeData
-getExoData = function(o, private, index)
-{
- index = dateIndexToInteger(index, o)
- private$.data[[index]]$exo
-}
-
-#' Exogeous predictions at specified index
-#'
-#' @inheritParams getTimeData
-getExoHatData = function(o, private, index)
-{
- index = dateIndexToInteger(index, o)
- private$.data[[index]]$exo_hat
-}
#' Return the (pointwise) average of the all the (similar) centered day curves
#' in the past. Inherits \code{\link{Forecaster}}
AverageForecaster = R6::R6Class("AverageForecaster",
- inherit = "Forecaster",
+ inherit = Forecaster,
public = list(
predictShape = function(today, memory, horizon, ...)
#' Predict tomorrow as a weighted combination of "futures of the past" days.
#' Inherits \code{\link{Forecaster}}
NeighborsForecaster = R6::R6Class("NeighborsForecaster",
- inherit = "Forecaster",
+ inherit = Forecaster,
public = list(
predictShape = function(today, memory, horizon, ...)
{
# (re)initialize computed parameters
- params <<- list("weights"=NA, "indices"=NA, "window"=NA)
+ private$.params <- list("weights"=NA, "indices"=NA, "window"=NA)
# Get optional args
simtype = ifelse(hasArg("simtype"), list(...)$simtype, "mix") #or "endo", or "exo"
kernel = ifelse(hasArg("kernel"), list(...)$kernel, "Gauss") #or "Epan"
if (hasArg(h_window))
- return (.predictShapeAux(fdays,today,horizon,list(...)$h_window,kernel,simtype,TRUE))
+ {
+ return ( private$.predictShapeAux(
+ fdays, today, horizon, list(...)$h_window, kernel, simtype, TRUE) )
+ }
# Determine indices of no-NAs days followed by no-NAs tomorrows
first_day = max(today - memory, 1)
for (i in intersect(fdays,sdays))
{
# mix_strategy is never used here (simtype != "mix"), therefore left blank
- prediction = .predictShapeAux(fdays, i, horizon, h, kernel, simtype, FALSE)
+ prediction = private$.predictShapeAux(fdays, i, horizon, h, kernel, simtype, FALSE)
if (!is.na(prediction[1]))
{
nb_jours = nb_jours + 1
h_best_endo = optimize(errorOnLastNdays, c(0,10), kernel=kernel, simtype="endo")$minimum
if (simtype == "endo")
- return (.predictShapeAux(fdays, today, horizon, h_best_endo, kernel, "endo", TRUE))
+ return(private$.predictShapeAux(fdays,today,horizon,h_best_endo,kernel,"endo",TRUE))
if (simtype == "exo")
- return (.predictShapeAux(fdays, today, horizon, h_best_exo, kernel, "exo", TRUE))
+ return(private$.predictShapeAux(fdays,today,horizon,h_best_exo,kernel,"exo",TRUE))
if (simtype == "mix")
{
h_best_mix = c(h_best_endo,h_best_exo)
- return (.predictShapeAux(fdays, today, horizon, h_best_mix, kernel, "mix", TRUE))
+ return(private$.predictShapeAux(fdays,today,horizon,h_best_mix,kernel,"mix",TRUE))
}
}
),
simils_endo * simils_exo
prediction = rep(0, horizon)
- for (i in seq_along(fdays_indices))
- prediction = prediction + similarities[i] * data$getSerie(fdays_indices[i]+1)[1:horizon]
+ for (i in seq_along(fdays))
+ prediction = prediction + similarities[i] * data$getSerie(fdays[i]+1)[1:horizon]
prediction = prediction / sum(similarities, na.rm=TRUE)
if (final_call)
{
- params$weights <<- similarities
- params$indices <<- fdays_indices
- params$window <<-
+ private$.params$weights <- similarities
+ private$.params$indices <- fdays
+ private$.params$window <-
if (simtype=="endo") {
h_endo
} else if (simtype=="exo") {
#' Return the last centered (similar) day curve.
#' Inherits \code{\link{Forecaster}}
PersistenceForecaster = R6::R6Class("PersistenceForecaster",
- inherit = "Forecaster",
+ inherit = Forecaster,
public = list(
predictShape = function(today, memory, horizon, ...)
#'
#' Return 0 (and then adjust). Inherits \code{\link{Forecaster}}
ZeroForecaster = R6::R6Class("ZeroForecaster",
- inherit = "Forecaster",
+ inherit = Forecaster,
public = list(
predictShape = function(today, memory, horizon, ...)
#'
#' Forecast encapsulation
#'
-#' @field pred List with
-#' \itemize{
-#' \item serie: forecasted serie
-#' \item params: corresponding list of parameters (weights, neighbors...)
-#' \item index: corresponding index in data object
-#' }
-#'
#' @docType class
#' @importFrom R6 R6Class
#'
-#' @export
+#' @field .pred List with \itemize{
+#' \item serie: forecasted serie
+#' \item params: corresponding list of parameters (weights, neighbors...)
+#' \item index: corresponding index in data object}
+#' @field .dates vector of day indices where forcast occurs
+#'
+#' @section Methods: \describe{
+#' \item{\code{initialize(dates)}}
+#' {Initialize a Forecast object with a series of date indices.}
+#' \item{\code{predictSerie(today,memory,horizon,...)}}
+#' {Predict a new serie of \code{horizon} values at day index \code{today} using \code{memory}
+#' days in the past.} TODO: continue #######################################
+#' \item{\code{predictShape(today,memory,horizon,...)}}
+#' {Predict a new shape of \code{horizon} values at day index \code{today} using \code{memory}
+#' days in the past.}
+#' \item{\code{getParameters()}}
+#' {Return (internal) parameters.} }
Forecast = R6::R6Class("Forecast",
private = list(
- .pred = "list",
- .dates = "Date"
+ .pred = list(),
+ .dates = c()
),
public = list(
initialize = function(dates)
- initialize(self, private, dates)
+ initializeForecast(self, private, dates)
,
getSize = function()
- getSize(private)
+ getSizeForecast(private)
,
append = function(new_serie, new_params, new_index)
- append(private, new_serie, new_params, new_index)
+ appendForecast(private, new_serie, new_params, new_index)
,
getDates = function()
- getDates(private)
+ getDatesForecast(private)
,
getSerie = function(index)
- getSerie(private, index)
+ getSerieForecast(private, index)
,
getParams = function(index)
- getParams(private, index)
+ getParamsForecast(private, index)
,
getIndexInData = function(index)
- getIndexInData(private, index)
+ getIndexInDataForecast(private, index)
)
)
#' @param o Object of class Forecast
#' @param private List of private members in o
#' @param dates vector of dates where forecast occurs
-initialize = function(o, private, dates)
+initializeForecast = function(o, private, dates)
{
- private$.dates <<- dates
- private$.pred <<- list()
+ private$.dates <- dates
invisible(o)
}
#' Number of individual forecasts"
#'
-#' @inheritParams initialize
-getSize = function(private)
+#' @inheritParams initializeForecast
+getSizeForecast = function(private)
length(private$.pred)
#' Obtain a new pair (serie, params)"
#'
-#' @inheritParams initialize
-append = function(new_serie, new_params, new_index_in_data)
+#' @inheritParams initializeForecast
+#' @param new_serie Values of a new serie
+#' @param new_params Associated (optimized) parameters
+#' @param new_index_in_data Corresponding index in data
+appendForecast = function(private, new_serie, new_params, new_index_in_data)
{
- private$.pred[[length(private$.pred)+1]] <<-
+ private$.pred[[length(private$.pred)+1]] <-
list("serie"=new_serie, "params"=new_params, "index_in_data"=new_index_in_data)
}
#' Dates where prediction occurs
#'
-#' inheritParams initialize
-getDates = function(private)
+#' inheritParams initializeForecast
+getDatesForecast = function(private)
private$.dates
#' Serie values at specified index"
#'
-#' @inheritParams initialize
+#' @inheritParams initializeForecast
#' @param index Return value at this index
-getSerie = function(index)
+getSerieForecast = function(index)
{
if (is(index,"Date"))
index = match(index, private$.dates)
#' Params at specified index"
#'
-#' @inheritParams getSerie
-getParams = function(index)
+#' @inheritParams getSerieForecast
+getParamsForecast = function(index)
{
if (is(index,"Date"))
index = match(index, private$.dates)
#' (day) Index in data where prediction took place"
#'
-#' @inheritParams getSerie
-getIndexInData = function(index)
+#' @inheritParams getSerieForecast
+getIndexInDataForecast = function(index)
{
if (is(index,"Date"))
index = match(index, private$.dates)
#'
#' Forecaster (abstract class, implemented by all forecasters)
#'
+#' @docType class
+#' @importFrom R6 R6Class
+#'
#' @field params List of computed parameters, for post-run analysis (dev)
#' @field data Dataset, object of class Data
#' @field pjump Function: how to predict the jump at day interface ?
#'
-#' @docType class
-#' @importFrom R6 R6Class
+#' @section Methods: \describe{
+#' \item{\code{initialize(data, pjump)}}
+#' {Initialize a Forecaster object with a Data object and a jump prediction function.}
+#' \item{\code{predictSerie(today,memory,horizon,...)}}
+#' {Predict a new serie of \code{horizon} values at day index \code{today} using \code{memory}
+#' days in the past.}
+#' \item{\code{predictShape(today,memory,horizon,...)}}
+#' {Predict a new shape of \code{horizon} values at day index \code{today} using \code{memory}
+#' days in the past.}
+#' \item{\code{getParameters()}}
+#' {Return (internal) parameters.} }
Forecaster = R6::R6Class("Forecaster",
private = list(
- .params = "list",
- .data = "Data",
- .pjump = "function"
+ .params = list(),
+ .data = NULL,
+ .pjump = NULL
),
public = list(
initialize = function(data, pjump)
- initialize(self, private, data, pjump)
- ,
+ {
+ private$.data <- data
+ private$.pjump <- pjump
+ invisible(self)
+ },
predictSerie = function(today, memory, horizon, ...)
- predictSerie(private, today, memory, horizon, ...)
- ,
+ {
+ # Parameters (potentially) computed during shape prediction stage
+ predicted_shape = o$predictShape(today, memory, horizon, ...)
+ predicted_delta = private$.pjump(private$.data,today,memory,horizon,private$.params,...)
+ # Predicted shape is aligned it on the end of current day + jump
+ predicted_shape+tail(private$.data$getSerie(today),1)-predicted_shape[1]+predicted_delta
+ },
predictShape = function(today, memory, horizon, ...)
- predictShape(private, today, memory, horizon, ...)
+ #empty default implementation: to implement in inherited classes
,
getParameters = function()
- getParameters(private)
+ private$.params
)
)
-
-#' Initialize (generic) Forecaster object
-#'
-#' @param o Object of class Forecaster
-#' @param private List of private members in o
-#' @param data Object of class Data
-#' @param pjump Function to predict jump
-initialize = function(o, private, data, pjump)
-{
- .params <<- list()
- .data <<- data
- .pjump <<- pjump
- invisible(o)
-}
-
-#' Obtain a new forecasted time-serie
-#'
-#' @inheritParams initialize
-#' @param today Index for current prediction
-#' @param memory Depth in data (in days)
-#' @param horizon Number of hours to forecast
-predictSerie = function(private, today, memory, horizon, ...)
-{
- # Parameters (potentially) computed during shape prediction stage
- predicted_shape = predictShape(today, memory, horizon, ...)
- predicted_delta = private$.pjump(private$.data, today, memory, horizon, params, ...)
- # Predicted shape is aligned it on the end of current day + jump
- predicted_shape + tail(private$.data$getSerie(today),1) - predicted_shape[1] + predicted_delta
-}
-
-#' Shape prediction (centered curve)
-#'
-#' @inheritParams predictSerie
-predictShape = function(private, today, memory, horizon, ...)
- #empty default implementation: to implement in inherited classes
-
-#' Get parameters list
-#'
-#' @inheritParams initialize
-getParameters = function(private)
- private$.params
#' @param horizon Number of time steps to predict
#' @param ... Additional parameters for the forecasting models
#'
-#' @return A list with the following items
-#' \itemize{
-#' \item serie: forecasted serie
-#' \item params: corresponding list of parameters (weights, neighbors...)
-#' \item index: corresponding index in data object
-#' }
+#' @return An object of class Forecast
#'
#' @examples
#' ts_data = system.file("extdata","pm10_mesures_H_loc.csv",package="talweg")
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(seq_along(indices), function(i) dateIndexToInteger(indices[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 = Forecast$new()
+ pred = Forecast$new( dates=sapply( indices, integerIndexToDate, data ) )
forecaster_class_name = getFromNamespace(paste(forecaster,"Forecaster",sep=""), "talweg")
forecaster = forecaster_class_name$new(data=data,
pjump = getFromNamespace(paste("get",pjump,"JumpPredict",sep=""), "talweg"))
- for (today in indices)
+ for (today in integer_indices)
{
pred$append(
new_serie = forecaster$predictSerie(today, memory, horizon, ...),
#' @param predict_at When does the prediction take place ? Integer, in hours. Default: 0
#' @param limit Number of days to extract (default: Inf, for "all")
#'
-#' @return A list where data[[i]] contains
-#' \itemize{
-#' \item time: vector of times
-#' \item centered_serie: centered serie
-#' \item level: corresponding level
-#' \item exo: exogenous variables
-#' \item exo_hat: predicted exogenous variables
-#' }
+#' @return An object of class Data
#'
#' @examples
#' ts_data = read.csv(system.file("extdata","pm10_mesures_H_loc.csv",package="talweg"))
line = 1 #index in PM10 file (24 lines for 1 cell)
nb_lines = nrow(ts_df)
nb_exos = ( ncol(exo_df) - 1 ) / 2
- data = list()
+ data = Data$new()
i = 1 #index of a cell in data
while (line <= nb_lines)
{
exo_hat = as.data.frame( exo_df[i,(1+nb_exos+1):(1+2*nb_exos)] )
level = mean(serie, na.rm=TRUE)
centered_serie = serie - level
- data[[i]] = list("time"=time, "centered_serie"=centered_serie, "level"=level,
- "exo"=exo, "exo_hat"=exo_hat)
+ data$append(time, centered_serie, level, exo, exo_hat)
if (i >= limit)
break
i = i + 1
}
- start = 1
- end = length(data)
- if (length(data[[1]]$centered_serie) < length(data[[2]]$centered_serie))
- start = 2
- if (length(data[[length(data)]]$centered_serie) <
- length(data[[length(data)-1]]$centered_serie))
+ if (length(data$getCenteredSerie(1)) < length(data$getCenteredSerie(2)))
+ data$removeFirst()
+ if (length(data$getCenteredSerie(data$getSize()))
+ < length(data$getCenteredSerie(data$getSize()-1)))
{
- end = end-1
+ data$removeLast()
}
- if (start>1 || end<length(data))
- data = data[start:end]
data
}
#' @export
dateIndexToInteger = function(index, data)
{
- index = index[1]
if (is.numeric(index))
index = as.integer(index)
if (is.integer(index))
- return (index)
+ return (index) #works on integers too: trust input
if (inherits(index, "Date") || is.character(index))
{
tryCatch(indexAsDate <- as.Date(index), error=function(e) stop("Unrecognized index format"))
#' @export
integerIndexToDate = function(index, data)
{
+ if (is(index,"Date"))
+ return (index) #works on dates too: trust input
index = index[1]
if (is.numeric(index))
index = as.integer(index)
if (!is.integer(index))
- stop("'index' should be an integer")
+ stop("'index' should be a date or integer")
as.Date( data$getTime(index)[1] )
}
projects / talweg.git / commitdiff