+++ /dev/null
-#' @include z_util.R
-
-#' @title Algorithm
-#'
-#' @description Generic class to represent an algorithm
-#'
-#' @field H The window [t-H+1, t] considered for prediction at time step t+1
-#' @field data Data frame of the last H experts forecasts + observations.
-#'
-Algorithm = setRefClass(
- Class = "Algorithm",
-
- fields = list(
- H = "numeric",
- data = "data.frame"
- ),
-
- methods = list(
- initialize = function(...)
- {
- "Initialize (generic) Algorithm object"
-
- callSuper(...)
- if (length(H) == 0 || H < 1)
- H <<- Inf
- },
- inputNextForecasts = function(x)
- {
- "Obtain a new series of vectors of experts forecasts (1 to K)"
-
- nd = nrow(data)
- nx = nrow(x)
- indices = (nd+1):(nd+nx)
-
- appendedData = as.data.frame(matrix(nrow=nx, ncol=ncol(data), NA))
- names(appendedData) = names(data)
- data <<- rbind(data, appendedData)
- data[indices,names(x)] <<- x
- },
- inputNextObservations = function(y)
- {
- "Obtain the observations corresponding to last input forecasts"
-
- #if all experts made a large unilateral error and prediction is very bad, remove data
- n = nrow(data)
- lastTime = data[n,"Date"]
- xy = subset(data, subset=(Date == lastTime))
- xy[,"Measure"] = y
- x = xy[,names(xy) != "Measure"]
- y = xy[,"Measure"]
- ranges = apply(x-y, 1, range)
- predictableIndices = (ranges[2,] > -MAX_ERROR & ranges[1,] < MAX_ERROR)
-# predictableIndices = 1:length(y)
- data <<- data[1:(n-nrow(xy)),]
- data <<- rbind(data, xy[predictableIndices,])
-
- #oldest rows are removed to prevent infinitely growing memory usage,
- #or to allow a window effect (parameter H)
- delta = nrow(data) - min(H, MAX_HISTORY)
- if (delta > 0)
- data <<- data[-(1:delta),]
- },
- predict_withNA = function()
- {
- "Predict observations corresponding to the last input forecasts. Potential NAs"
-
- n = nrow(data)
- if (data[n,"Date"] == 1)
- {
- #no measures added so far
- return (rep(NA, n))
- }
-
- nx = n - nrow(subset(data, subset = (Date == data[n,"Date"])))
- x = data[(nx+1):n, !names(data) %in% c("Date","Measure","Station")]
- experts = names(x)
- prediction = c()
-
- #extract a maximal submatrix of data without NAs
-
- iy = getNoNAindices(x, 2)
- if (!any(iy))
- {
- #all columns of x have at least one NA
- return (rep(NA, n-nx))
- }
-
- data_noNA = data[1:nx,c(experts[iy], "Measure")]
- ix = getNoNAindices(data_noNA)
- if (!any(ix))
- {
- #no full line with NA-pattern similar to x[,iy]
- return (rep(NA, n-nx))
- }
-
- data_noNA = data_noNA[ix,]
- xiy = as.data.frame(x[,iy])
- names(xiy) = names(x)[iy]
- res = predict_noNA(data_noNA, xiy)
- #basic sanitization: force all values >=0
- res[res < 0.] = 0.
- return (res)
- },
- predict_noNA = function(XY, x)
- {
- "Predict observations corresponding to x. No NAs"
-
- #empty default implementation: to implement in inherited classes
- }
- )
-)