-
Notifications
You must be signed in to change notification settings - Fork 0
/
TestingPredictions.R
107 lines (76 loc) · 3.76 KB
/
TestingPredictions.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
# Automatic forecasting with sliding window approach ----
source("ensembles.R")
pickwindow <- function(data, N.win){
data_sub <- data[N.slid.win %in% N.win, lapply(Load, as.vector), by = N.K]
data_sub[, N.K := NULL]
data_sub <- data.matrix(data_sub)
data_sub
}
ForecastClustersEnsemble <- function(dataset, FUN = bld.mbb.bootstrap){
n_day <- length(unique(dataset$N.slid.win))
data_list <- lapply(0:(n_day-1), function(x) pickwindow(dataset, x))
cl <- makeForkCluster(detectCores()-1, outfile = "debug.txt")
registerDoParallel(cl)
pred_clusters <- parLapply(cl, 1:(length(data_list)),
function(i) lapply(1:dim(data_list[[i]])[1], function(j)
predEnsembles(data_list[[i]][j,], 100, FUN = FUN)))
if(!is.null(cl)){
parallel::stopCluster(cl)
cl <- c()
}
res <- sapply(seq_len(length(pred_clusters[[1]][[1]])),
function(k) as.vector(sapply(seq_len(length(pred_clusters)),
function(i) rowSums(sapply(seq_len(length(pred_clusters[[i]])),
function(j) as.vector(pred_clusters[[i]][[j]][[k]]))))))
return(res)
}
ForecastClustersSimple <- function(dataset){
n_day <- length(unique(dataset$N.slid.win))
data_list <- lapply(0:(n_day-1), function(x) pickwindow(dataset, x))
pred_clusters <- lapply(1:(length(data_list)),
function(i) lapply(1:dim(data_list[[i]])[1],
function(j) predSimAll(data_list[[i]][j,])))
res <- sapply(seq_len(length(pred_clusters[[1]][[1]])),
function(k) as.vector(sapply(seq_len(length(pred_clusters)),
function(i) rowSums(sapply(seq_len(length(pred_clusters[[i]])),
function(j) as.vector(pred_clusters[[i]][[j]][[k]]))))))
return(res)
}
ForecastAggregatedEnsemble <- function(dataset, FUN = bld.mbb.bootstrap){
win <- 21
days_for <- length(dataset)/seas - win
cl <- makeForkCluster(detectCores()-1, outfile = "debug.txt")
registerDoParallel(cl)
pred_sums <- parLapply(cl, 0:(days_for-1), function(i) predEnsembles(dataset[((i*seas)+1):((seas*i)+(win*seas))],
FUN = FUN))
if(!is.null(cl)){
parallel::stopCluster(cl)
cl <- c()
}
predictions <- sapply(seq_len(length(pred_sums[[1]])),
function(k) sapply(seq_len(days_for),
function(j) as.vector(pred_sums[[j]][[k]])))
return(predictions)
}
ForecastAggregatedSimple <- function(dataset){
win <- 21
days_for <- length(dataset)/seas - win
pred_sums <- lapply(0:(days_for-1),
function(i) predSimAll(dataset[((i*seas)+1):((seas*i)+(win*seas))]))
predictions <- sapply(seq_len(length(pred_sums[[1]])),
function(k) sapply(seq_len(days_for),
function(j) as.vector(pred_sums[[j]][[k]])))
return(predictions)
}
# Compute sMAPE ----
computeMape <- function(real, predictions){
win <- 21
data_test <- real[-(1:(win*seas))]
n_day <- length(data_test)/seas
err_byday <- sapply(seq_len(dim(predictions)[2]),
function(i) sapply(0:(n_day-1),
function(j) smape(as.vector(data_test[((j*seas)+1):(seas*(j+1))]), predictions[((j*seas)+1):(seas*(j+1)), i])))
err_whole <- sapply(seq_len(dim(predictions)[2]),
function(i) smape(as.vector(data_test), predictions[, i]))
return(list(ByDay = err_byday, Whole = matrix(err_whole)))
}