aggexp/R/b_Algorithm.R

   1 #' @include z_util.R
   2
   3 #' @title Algorithm
   4 #'
   5 #' @description Generic class to represent an algorithm
   6 #'
   7 #' @field H The window [t-H+1, t] considered for prediction at time step t+1
   8 #' @field data Data frame of the last H experts forecasts + observations.
   9 #'
  10 Algorithm = setRefClass(
  11     Class = "Algorithm",
  12
  13     fields = list(
  14         H = "numeric",
  15         data = "data.frame"
  16     ),
  17
  18     methods = list(
  19         initialize = function(...)
  20         {
  21             "Initialize (generic) Algorithm object"
  22
  23             callSuper(...)
  24             if (length(H) == 0 || H < 1)
  25                 H <<- Inf
  26         },
  27         inputNextForecasts = function(x)
  28         {
  29             "Obtain a new series of vectors of experts forecasts (1 to K)"
  30
  31             nd = nrow(data)
  32             nx = nrow(x)
  33             indices = (nd+1):(nd+nx)
  34
  35             appendedData = as.data.frame(matrix(nrow=nx, ncol=ncol(data), NA))
  36             names(appendedData) = names(data)
  37             data <<- rbind(data, appendedData)
  38             data[indices,names(x)] <<- x
  39         },
  40         inputNextObservations = function(y)
  41         {
  42             "Obtain the observations corresponding to last input forecasts"
  43
  44             #if all experts made a large unilateral error and prediction is very bad, remove data
  45             n = nrow(data)
  46             lastTime = data[n,"Date"]
  47             xy = subset(data, subset=(Date == lastTime))
  48             xy[,"Measure"] = y
  49             x = xy[,names(xy) != "Measure"]
  50             y = xy[,"Measure"]
  51             ranges = apply(x-y, 1, range)
  52             predictableIndices = (ranges[2,] > -MAX_ERROR & ranges[1,] < MAX_ERROR)
  53 #           predictableIndices = 1:length(y)
  54             data <<- data[1:(n-nrow(xy)),]
  55             data <<- rbind(data, xy[predictableIndices,])
  56
  57             #oldest rows are removed to prevent infinitely growing memory usage,
  58             #or to allow a window effect (parameter H)
  59             delta = nrow(data) - min(H, MAX_HISTORY)
  60             if (delta > 0)
  61                 data <<- data[-(1:delta),]
  62         },
  63         predict_withNA = function()
  64         {
  65             "Predict observations corresponding to the last input forecasts. Potential NAs"
  66
  67             n = nrow(data)
  68             if (data[n,"Date"] == 1)
  69             {
  70                 #no measures added so far
  71                 return (rep(NA, n))
  72             }
  73
  74             nx = n - nrow(subset(data, subset = (Date == data[n,"Date"])))
  75             x = data[(nx+1):n, !names(data) %in% c("Date","Measure","Station")]
  76             experts = names(x)
  77             prediction = c()
  78
  79             #extract a maximal submatrix of data without NAs
  80
  81             iy = getNoNAindices(x, 2)
  82             if (!any(iy))
  83             {
  84                 #all columns of x have at least one NA
  85                 return (rep(NA, n-nx))
  86             }
  87
  88             data_noNA = data[1:nx,c(experts[iy], "Measure")]
  89             ix = getNoNAindices(data_noNA)
  90             if (!any(ix))
  91             {
  92                 #no full line with NA-pattern similar to x[,iy]
  93                 return (rep(NA, n-nx))
  94             }
  95
  96             data_noNA = data_noNA[ix,]
  97             xiy = as.data.frame(x[,iy])
  98             names(xiy) = names(x)[iy]
  99             res = predict_noNA(data_noNA, xiy)
 100             #basic sanitization: force all values >=0
 101             res[res < 0.] = 0.
 102             return (res)
 103         },
 104         predict_noNA = function(XY, x)
 105         {
 106             "Predict observations corresponding to x. No NAs"
 107
 108             #empty default implementation: to implement in inherited classes
 109         }
 110     )
 111 )