-
Notifications
You must be signed in to change notification settings - Fork 1
/
Rolling window - SVR_alternative_function.R
96 lines (72 loc) · 3.5 KB
/
Rolling window - SVR_alternative_function.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
# rm(list=ls())
library(githubinstall) # library for getting the under-development part of mlr package
# gh_install_packages("mlr-org/mlr", ref = "forecasting")
# installation of a package augmentation -- cross-validation for time-series
library(RCurl) # data download from ftp server
library(dplyr)
library(kernlab) # SVR via ksvm() - caret does not support svm() with RBF kerneù
library(forecast) # ARIMA via auto.arima()
library(tseries)
library(PSF) # PSF via psf()
library(mlr) # train() for optimalization
library(emoa) # required by mlr package
library(FSelector)
library(parallelMap)
set.seed(100)
functionalize.list.creation <- function(n.of.lags, n.of.iters) {
svrPerfFeat <- list(a, b, c)
svrPredFeat <- list()
svrParamsFeat <- list()
# starting parallelization
parallelStartSocket(2)
for(i in 1:n.of.iters){ # loop for training the actual model
# n.of.lags lags used
# moving training data set
svmTrainResp <- ts2[(25 + (i-1)*168):(528 + (i-1)*168)] # response in training
svmTrainPred <- data.frame()
for (j in 0:503){
auxTrainPred <- c(ts2[((24 - n.of.lags + 1) + (i-1)*168 + j):(24 + (i-1)*168 + j)]) # predictors in training
svmTrainPred <- rbind(svmTrainPred, auxTrainPred) # binding all predictors
}
svmTrain <- cbind(svmTrainPred, svmTrainResp) # finished data set
colnames(svmTrain) <- c(paste("lag", n.of.lags:1,sep = ""), "response")
# moving testing data set
svmTestResp <- ts2[(529 + (i-1)*168):(696 + (i-1)*168)] # response in testing
svmTestPred <- data.frame()
for (j in 0:167){
auxTestPred <- c(ts2[((528 - n.of.lags + 1) + (i-1)*168 + j):(528 + (i-1)*168 + j)]) # predictors
svmTestPred <- rbind(svmTestPred, auxTestPred) # binding all predictors
}
svmTest <- cbind(svmTestPred, svmTestResp) # finished data set
colnames(svmTest) <- c(paste("lag", n.of.lags:1,sep = ""), "response")
# parameter optimization
regrTr1 <- makeRegrTask(data = svmTrain, target = "response")
svmTune <- tuneParamsMultiCrit("regr.ksvm", task = regrTr1, resampling = rdescAlt, par.set = psAlt,
measures = list(mae, rmse), control = ctrlAlt, show.info = FALSE)
# optimized model learning
optParams <- vector()
for(k in 1:length(svmTune$x)){ # get the best set in case of multiple optima
optParams[k] <- svmTune$x[[k]]$C # high C tends to screw up predictions a bit
}
svrParamsFeat[[i]] <- svmTune$x[[which.min(optParams)]]
lrnFilter2 <- setHyperPars(makeLearner("regr.ksvm"), par.vals = svmTune$x[[which.min(optParams)]])
modelFinal <- train(lrnFilter2, task = regrTr1)
# predictions
regrTe1 <- makeRegrTask(data = svmTest, target = "response")
predSVM <- predict(modelFinal, task = regrTe1)
# measures
svrPredFeat[[i]] <- predSVM
svrPerfFeat[[1]][i] <- sum(abs((predSVM$data$truth - predSVM$data$response)))/ length(predSVM$data$truth)
svrPerfFeat[[2]][i] <- sum(abs((predSVM$data$truth - predSVM$data$response)
/ predSVM$data$truth)) / length(predSVM$data$truth)
svrPerfFeat[[3]][i] <- sqrt(sum((predSVM$data$truth - predSVM$data$response)^2) / length(predSVM$data$truth))
print(i)
}
result<-list(n.of.lags, svrPerfFeat, svrPredFeat, svrParamsFeat)
# stopping parallelization
parallelStop()
return(result)
}
lag3 <- functionalize.list.creation(3, 100)
lag4 <- functionalize.list.creation(4, 100)
lag5 <- functionalize.list.creation(5, 100)