reorganize folder

[aggexp.git] / R / b_Algorithm.R

diff --git a/R/b_Algorithm.R b/R/b_Algorithm.R
deleted file mode 100644 (file)
index 3ff9cc9..0000000
--- a/R/b_Algorithm.R
+++ /dev/null
@@ -1,111 +0,0 @@
-#' @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
-               }
-       )
-)