reorganize folder
[aggexp.git] / 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 )