NN Train Function
hyperParams <- function(optim_method) {
if (!is.element(optim_method, c("backprop", "rprop+", "rprop-", "sag", "slr"))) stop("Invalid Parameters.")
if (optim_method == "backprop") {iter <- 50000}
if (optim_method == "rprop+") {iter <- 50000}
if (optim_method == "rprop-") {iter <- 50000}
if (optim_method == "sag") {iter <- 50000}
if (optim_method == "slr") {iter <- 50000}
params <- paste0("method=", optim_method, "_iter=", iter)
out <- list(iter = iter, params = params)
return (out)
}
NNtrain <- function(fmla, data, optim_method) {
hyper_params <- hyperParams(optim_method)
iter <- hyper_params$iter
bb <- round(rnorm(nparNN, sd = 0.1), 4)
names(bb) <- paste0("b", 1:nparNN)
NNreg <- neuralnet::neuralnet(fmla, data = Zxy,
hidden = neur,
algorithm = optim_method,
stepmax = iter,
startweights = bb,
act.fct = "tanh")
return(NNreg)
}
Main Loop
for (dset in names(NNdatasets)) {
## =============================================
## EXTRACT INFORMATION FROM THE SELECTED DATASET
## =============================================
ds <- NNdatasets[[dset]]$ds
Z <- NNdatasets[[dset]]$Z
neur <- NNdatasets[[dset]]$neur
nparNN <- NNdatasets[[dset]]$nparNN
fmlaNN <- NNdatasets[[dset]]$fmlaNN
donotremove <- c("dset", "dsets", "ds", "Z", "neur", "TF", "nrep", "timer",
"donotremove", "donotremove2")
donotremove2 <- c("dset", "dsets")
## ===================================================
## SELECT THE FORMAT REQUIRED BY THE PACKAGE/ALGORITHM
## d = data.frame, m = matrix, v = vector/numeric
## ATTACH THE OBJECTS CREATED (x, y, Zxy, ... )
## ===================================================
ZZ <- prepareZZ(Z, zdm = "d", scale = FALSE)
attach(ZZ)
## =============================================
## SELECT THE PACKAGE USED FOR TRAINING
## nrep => SELECT THE NUMBER OF INDEPENDANT RUNS
## iter => SELECT THE MAX NUMBER OF ITERATIONS
## TF => PLOT THE RESULTS
## =============================================
nrep <- 10
TF <- TRUE
method <- c("backprop", "rprop+", "rprop-", "sag", "slr")
for (m in method) {
descr <- paste(dset, "neuralnet::neuralnet", m, sep = "_")
##AUTO
Ypred <- list()
Rmse <- numeric(length = nrep)
Mae <- numeric(length = nrep)
for(i in 1:nrep){
event <- paste0(descr, sprintf("_%.2d", i))
timer$start(event)
#### ADJUST THE FOLLOWING LINES TO THE PACKAGE::ALGORITHM
hyper_params <- hyperParams(optim_method = m)
NNreg <- tryCatch(
NNtrain(fmla = fmla, data = Zxy, optim_method = m),
error = function(y) {lm(y ~ 0, data = Zxy)}
)
y_pred <- tryCatch(
ym0 + ysd0*as.numeric(predict(NNreg, newdata = x)),
error = function(NNreg) rep(ym0, nrow(Zxy))
)
####
Ypred[[i]] <- y_pred
Rmse[i] <- funRMSE(y_pred, y0)
Mae[i] <- funMAE(y_pred, y0)
timer$stop(event, RMSE = Rmse[i], MAE = Mae[i], params = hyper_params$params, printmsg = FALSE)
}
best <- which(Rmse == min(Rmse, na.rm = TRUE))[1]
best ; Rmse[[best]]
## ================================================
## PLOT ALL MODELS AND THE MODEL WITH THE BEST RMSE
## par OPTIONS CAN BE IMPROVED FOR A BETTER DISPLAY
## ================================================
op <- par(mfcol = c(1,2))
plotNN(xory, y0, uni, TF, main = descr)
for (i in 1:nrep){lipoNN(xory, Ypred[[i]], uni, TF, col = i, lwd = 1)}
plotNN(xory, y0, uni, TF, main = descr)
lipoNN(xory, Ypred[[best]], uni, TF, col = 4, lwd = 4)
par(op)
}
## ===========================
## DETACH ZZ - END OF THE LOOP
## ===========================
detach(ZZ)
}
Results
dfr0 <- getTimer(timer)
dfr <- data.frame(
ds_pkg.fun_algo = stringr::str_sub(dfr0[ ,1], 1, -4),
run = stringr::str_sub(dfr0[ ,1], -2, -1),
dfr0[, c("RMSE","MAE")],
dataset = stringr::str_replace_all(stringr::str_extract(dfr0[, 1], pattern = "^\\w*_"), fixed("_"), ""),
method = stringr::str_replace_all(stringr::str_extract(dfr0[, 1], pattern = "_\\w*_"), fixed("_"), ""),
Elapsed = round(dfr0[ ,4], 5),
params = dfr0$params
)
dfr %>%
select(-c(dataset, method))
Best Results
dataset
|
method
|
minRMSE
|
meanRMSE
|
meanTime
|
mDette
|
backprop
|
14.0137
|
14.013700
|
0.0040
|
sag
|
8.1656
|
11.089650
|
3.0060
|
slr
|
8.1656
|
9.920030
|
1.8500
|
NA
|
6.1676
|
10.889850
|
3.3100
|
mFriedman
|
backprop
|
0.6122
|
0.612200
|
0.0010
|
sag
|
0.6122
|
0.612200
|
7.5390
|
slr
|
0.6122
|
0.612200
|
7.5500
|
NA
|
0.0087
|
0.472580
|
6.5575
|
mIshigami
|
backprop
|
4.9597
|
4.959700
|
0.0010
|
sag
|
4.9597
|
4.959700
|
12.3060
|
slr
|
4.9597
|
4.959700
|
12.3030
|
NA
|
4.9597
|
4.959700
|
11.8895
|
mRef153
|
backprop
|
57.2337
|
57.233700
|
0.0000
|
sag
|
27.8983
|
27.898300
|
0.0140
|
slr
|
27.8983
|
27.898300
|
0.0180
|
NA
|
27.8983
|
27.898300
|
0.0115
|
uDmod1
|
backprop
|
0.5885
|
0.588500
|
0.0010
|
sag
|
0.0571
|
0.535360
|
3.1130
|
slr
|
0.0519
|
0.274090
|
2.0290
|
NA
|
0.0473
|
0.155370
|
1.0020
|
uDmod2
|
backprop
|
0.5179
|
0.517900
|
0.0020
|
sag
|
0.5179
|
0.517900
|
3.1330
|
slr
|
0.0438
|
0.070910
|
1.1980
|
NA
|
0.0498
|
0.188845
|
0.4615
|
uDreyfus1
|
backprop
|
1.6305
|
1.630500
|
0.0010
|
sag
|
0.0720
|
0.857390
|
1.9180
|
slr
|
0.0057
|
0.031740
|
0.6380
|
NA
|
0.0045
|
0.032145
|
0.1315
|
uDreyfus2
|
backprop
|
1.6298
|
1.629800
|
0.0010
|
sag
|
0.1558
|
1.335520
|
2.3610
|
slr
|
0.0910
|
0.269290
|
0.6780
|
NA
|
0.0909
|
0.108740
|
0.1470
|
uGauss1
|
backprop
|
73.4624
|
73.462400
|
0.0020
|
sag
|
41.6253
|
41.625300
|
0.0090
|
slr
|
41.6253
|
41.625300
|
0.0120
|
NA
|
41.6253
|
41.625300
|
0.0115
|
uGauss2
|
backprop
|
71.3049
|
71.304900
|
0.0010
|
sag
|
37.6867
|
37.686700
|
0.0110
|
slr
|
37.6867
|
37.686700
|
0.0130
|
NA
|
37.6867
|
37.686700
|
0.0125
|
uGauss3
|
backprop
|
72.5907
|
72.590700
|
0.0010
|
sag
|
40.0663
|
40.066300
|
0.0130
|
slr
|
40.0663
|
40.066300
|
0.0130
|
NA
|
40.0663
|
40.066300
|
0.0125
|
uNeuroOne
|
backprop
|
1.3012
|
1.301200
|
0.0020
|
sag
|
0.6159
|
1.092770
|
2.0530
|
slr
|
0.6164
|
1.027330
|
1.9580
|
NA
|
0.2830
|
0.451685
|
1.0320
|