library(NNbenchmark)
library(stringr)
library(dplyr)
library(kableExtra)options(scipen = 9999)
options("digits.secs" = 2)
timer <- createTimer(verbose = FALSE)NNdataSummary(NNdatasets)## Dataset n_rows n_inputs n_neurons n_parameters
## 1 mDette 500 3 5 26
## 2 mFriedman 500 5 5 36
## 3 mIshigami 500 3 10 51
## 4 mRef153 153 5 3 22
## 5 uDmod1 51 1 6 19
## 6 uDmod2 51 1 5 16
## 7 uDreyfus1 51 1 3 10
## 8 uDreyfus2 51 1 3 10
## 9 uGauss1 250 1 5 16
## 10 uGauss2 250 1 4 13
## 11 uGauss3 250 1 4 13
## 12 uNeuroOne 51 1 2 7odir <- "~/Documents/recherche-enseignement/code/R/NNbenchmark-project/NNtempresult/"Should be part of the NNbenchmark package?!
funWAE <- function(y_pred, y0, dgts = 4)
{
y_pred <- as.numeric(y_pred)
y0 <- as.numeric(y0)
res <- abs(y_pred - y0)
z <- max(res, na.rm = TRUE)
round(z, dgts)
}
NNsummary <- function(pred, obsy, time)
c(RMSE = NNbenchmark::funRMSE(pred, obsy), MAE= NNbenchmark::funMAE(pred, obsy),
WAE= funWAE(pred, obsy), time=time)
train_and_predict_1mth_1data <- function(dset, method, trainFUN, hyperparamFUN, predictFUN, summaryFUN,
prepareZZ.arg=list(),
nrep=5, doplot=FALSE, plot.arg=list(col1=1:nrep, lwd1=1, col2=4, lwd2=3),
pkgname, pkgfun, rdafile=FALSE, odir="~/", echo=FALSE, echoreport=1, ...)
{
method <- method[1]
if(!is.list(plot.arg) || any(!names(plot.arg) %in% c("col1", "lwd1", "col2", "lwd2")))
plot.arg <- list(col1=1:nrep, lwd1=1, col2=4, lwd2=3)
plot.arg$col1 <- rep(plot.arg$col1, length.out=nrep)
if(!exists(hyperparamFUN))
stop(paste("function", hyperparamFUN, "does not exist"))
if(!exists(trainFUN))
stop(paste("function", trainFUN, "does not exist"))
if(!exists(predictFUN))
stop(paste("function", predictFUN, "does not exist"))
timer <- createTimer(verbose = FALSE)
ds <- NNbenchmark::NNdatasets[[dset]]$ds
Z <- NNbenchmark::NNdatasets[[dset]]$Z
neur <- NNbenchmark::NNdatasets[[dset]]$neur
nparNN <- NNbenchmark::NNdatasets[[dset]]$nparNN
fmlaNN <- NNbenchmark::NNdatasets[[dset]]$fmlaNN
descr <- paste0(ds, "_", pkgname, "::", pkgfun, "_", method)
if(echo)
{
cat(paste0(rep("_",80),collapse=""),"\n")
cat("***\t", descr, "***\n")
}
if(length(prepareZZ.arg) != 4 || any(!names(prepareZZ.arg) %in% c("xdmv", "ydmv", "zdm", "scale")))
prepareZZ.arg <- list(xdmv = "d", ydmv = "v", zdm = "d", scale = TRUE)
ZZ <- do.call("prepareZZ", c(list(Z), prepareZZ.arg))
if(echo && echoreport > 1)
{
cat("prepareZZ\n")
print(str(ZZ))
}
Ypred <- list()
allsummary <- list()
for(i in 1:nrep)
{
timer$start(descr)
tempfit <- tryCatch(
do.call(trainFUN, list(ZZ$x, ZZ$y, ZZ$Zxy, ZZ$fmla, neur, method, hyperparamFUN, fmlaNN, nparNN)),
error = function(y) {lm(y ~ 0, data = ZZ$Zxy)}
)
if(echo && echoreport > 1)
{
cat("\n\t\t--- debug : structure of fitted model ***\n")
print(str(tempfit))
cat("\n\t\t--- debug : summary of fitted model ***\n")
print(summary(tempfit))
}
if(inherits(tempfit, "lm") || inherits(tempfit, "try-error"))
{
if(echo && echoreport > 1)
{
cat("\n--- \tdebug : training lead to error \t***\n")
cat(pkgname, "::", pkgfun, "_", method, "\n")
}
Ypred[[i]] <- rep(ZZ$ym0, length.out=NROW(ZZ$x))
}else
{
if(echo && echoreport > 1)
{
localpred <- try(do.call(predictFUN, list(tempfit, head(ZZ$x), head(ZZ$xy))), silent=echoreport > 2)
if(!inherits(localpred, "try-error"))
{
cat("\n\t\t--- debug : first predictions ***\n")
print(str(localpred))
}else
{
cat("\n--- \tdebug : first predictions lead to error \t***\n")
cat(pkgname, "::", pkgfun, "_", method, "\n")
print(localpred)
}
}
temppred <- try(do.call(predictFUN, list(tempfit, ZZ$x, ZZ$Zxy)), silent=echoreport > 2)
if(!inherits(temppred, "try-error"))
Ypred[[i]] <- ZZ$ym0 + ZZ$ysd0 * temppred
else
Ypred[[i]] <- rep(ZZ$ym0, length.out=NROW(ZZ$x))
}
timer$stop(descr, RMSE = NA, MAE = NA, params = NA, printmsg = FALSE)
allsummary[[i]] <- summaryFUN(Ypred[[i]], ZZ$y0, round(getTimer(timer)[ ,4], 5))
if(echo && i %% 5 == 0)
cat(pkgname, pkgfun, method, "i", i, "summary statistics", allsummary[[i]][1:3], "time", allsummary[[i]]["time"], "\n")
}
names(Ypred) <- names(allsummary) <- paste0("replicate", 1:nrep)
Ypred <- simplify2array(Ypred)
if(length(dim(Ypred)) >= 2)
if(dim(Ypred)[2] == 1)
{
if(length(dim(Ypred)) == 3)
Ypred <- Ypred[,1,]
else if(length(dim(Ypred)) == 2)
Ypred <- Ypred[,1]
}
allsummary <- simplify2array(allsummary)
best <- which.min(allsummary["RMSE",])
#outputs to file
if(rdafile)
{
descr <- paste0(ds, "_", pkgname, "_", pkgfun, "_", method)
myfile <- paste0(odir, descr, ".RData")
save(Ypred, allsummary, file=myfile)
}
#plot
if(doplot)
{
#shorter description
descr <- paste0(ds, "_", pkgname, "::", pkgfun, "_", method)
op <- par(mfcol = c(1,2))
plotNN(ZZ$xory, ZZ$y0, ZZ$uni, doplot, main = descr)
for (i in 1:nrep)
lipoNN(ZZ$xory, Ypred[,i], ZZ$uni, doplot, col = plot.arg$col1[i], lwd = plot.arg$lwd1)
plotNN(ZZ$xory, ZZ$y0, ZZ$uni, doplot, main = descr)
lipoNN(ZZ$xory, Ypred[,best], ZZ$uni, doplot, col = plot.arg$col2, lwd = plot.arg$lwd2)
par(op)
}
if(echo)
cat("\n")
allsummary[,best]
}train_and_predict_1data <- function(dset, methodvect, trainFUN, hyperparamFUN, predictFUN, summaryFUN,
closeFUN, startNN=NA, prepareZZ.arg=list(),
nrep=5, doplot=FALSE, plot.arg=list(),
pkgname="pkg", pkgfun="train", rdafile=FALSE, odir="~/", echo=FALSE, ...)
{
nbpkg <- length(pkgname)
#sanity check
if(nbpkg > 1)
{
if(length(pkgfun) != nbpkg )
stop("wrong pkgfun")
if(length(trainFUN) != nbpkg || length(hyperparamFUN) != nbpkg || length(predictFUN) != nbpkg || length(closeFUN) != nbpkg)
stop("wrong function names among trainFUN, hyperparamFUN, predictFUN, closeFUN")
if(length(methodvect) != nbpkg || !is.list(methodvect))
stop("wrong methodvect: too short")
if(length(prepareZZ.arg) != nbpkg || !is.list(prepareZZ.arg))
stop("wrong prepareZZ.arg: too short")
}
if(any(!sapply(methodvect, is.character)))
stop("methvect should be a list of vector of characters")
if(any(!is.character(trainFUN)))
stop("trainFUN should be a vector of characters")
if(any(!is.character(hyperparamFUN)))
stop("hyperparamFUN should be a vector of characters")
if(any(!is.character(predictFUN)))
stop("predictFUN should be a vector of characters")
if(any(!is.character(closeFUN)))
stop("predictFUN should be a vector of characters")
if(any(!is.character(pkgname)))
stop("pkgname should be a vector of characters")
if(any(!is.character(pkgfun)))
stop("pkgfun should be a vector of characters")
if(nbpkg == 1)
{
if(!exists(trainFUN))
stop(paste(trainFUN, "does not exist"))
if(!exists(hyperparamFUN))
stop(paste(hyperparamFUN, "does not exist"))
if(!exists(predictFUN))
stop(paste(predictFUN, "does not exist"))
if(!is.null(startNN) && !is.na(startNN))
{
if(!exists(startNN))
stop(paste("function", startNN, "does not exist"))
do.call(startNN, list())
}else
{
#cat("blii\n")
#print(pkgname[1])
#print(search())
x <- require(pkgname[1], character.only = TRUE)
#print(search())
#print(x)
}
resallmethod <- sapply(1:length(methodvect), function(i)
train_and_predict_1mth_1data(dset=dset, method=methodvect[i], trainFUN=trainFUN, hyperparamFUN=hyperparamFUN,
predictFUN=predictFUN, summaryFUN=summaryFUN,
prepareZZ.arg=prepareZZ.arg, nrep=nrep, doplot=doplot,
pkgname=pkgname, pkgfun=pkgfun, rdafile=rdafile, odir=odir,
echo=echo, ...))
if(!exists(closeFUN))
stop(paste("function", closeFUN, "does not exist"))
do.call(closeFUN, list())
colnames(resallmethod) <- methodvect
return(resallmethod)
}else
{
for(j in 1:nbpkg)
{
if(!exists(trainFUN[j]))
stop(paste(trainFUN[j], "does not exist"))
if(!exists(hyperparamFUN[j]))
stop(paste(hyperparamFUN[j], "does not exist"))
if(!exists(predictFUN[j]))
stop(paste(predictFUN[j], "does not exist"))
if(!exists(closeFUN[j]))
stop(paste(closeFUN[j], "does not exist"))
}
if(!is.null(startNN))
stopifnot(length(startNN) == nbpkg)
res1pkg <- function(j)
{
mymethod <- methodvect[[j]]
if(!is.null(startNN[j]) && !is.na(startNN[j]))
{
if(!exists(startNN[j]))
stop(paste("function", startNN[j], "does not exist"))
do.call(startNN[j], list())
}else
require(pkgname[j], character.only = TRUE)
resallmethod <- sapply(1:length(mymethod), function(i)
train_and_predict_1mth_1data(dset=dset, method=mymethod[i], trainFUN=trainFUN[j], hyperparamFUN=hyperparamFUN[j],
predictFUN=predictFUN[j],
summaryFUN=summaryFUN, prepareZZ.arg=prepareZZ.arg[[j]],
nrep=nrep, doplot=doplot, pkgname=pkgname[j], pkgfun=pkgfun[j], rdafile=rdafile,
odir=odir, echo=echo, ...))
if(!exists(closeFUN[j]))
stop(paste("function", closeFUN[j], "does not exist"))
do.call(closeFUN[j], list())
colnames(resallmethod) <- paste0(pkgname[j], "::", mymethod)
resallmethod
}
res <- sapply(1:nbpkg, res1pkg)
resfinal <- res[[1]]
for(i in 2:nbpkg)
resfinal <- cbind(resfinal, res[[i]])
return(resfinal)
}
}#library(AMORE)
hyperParams.AMORE <- function(optim_method, ...) {
if (!is.element(optim_method, c("ADAPTgd", "ADAPTgdwm", "BATCHgd", "BATCHgdwm"))) stop("Invalid Parameters.")
if (optim_method == "ADAPTgd") {iter <- 3500; lr <- 0.01; momentum <- 0; hidden_activation <- "tansig"}
if (optim_method == "ADAPTgdwm") {iter <- 4000; lr <- 0.009; momentum <- 0.8; hidden_activation <- "sigmoid"}
if (optim_method == "BATCHgd") {iter <- 7500; lr <- 0.01; momentum <- 0; hidden_activation <- "tansig"}
if (optim_method == "BATCHgdwm") {iter <- 9000; lr <- 0.008; momentum <- 0.7; hidden_activation <- "tansig"}
params <- paste0("method=", optim_method, "_lr=", lr, "_iter=", iter, "_momentum=", momentum, "_hidden_activation=", hidden_activation)
out <- list(iter = iter, lr = lr, params = params, momentum = momentum, hidden_activation = hidden_activation)
return (out)
}
NNtrain.AMORE <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
iter <- hyper_params$iter
lr <- hyper_params$lr
momentum <- hyper_params$momentum
hidden_activation <- hyper_params$hidden_activation
net_structure <- AMORE::newff(n.neurons = c(ncol(x), hidden_neur, 1), learning.rate.global = lr,
error.criterium = "LMS", hidden.layer = hidden_activation,
method = optim_method, momentum.global = momentum)
NNreg <- AMORE::train(net = net_structure, P = x, T = y, error.criterium = "LMS",
report = FALSE, n.shows = iter, show.step = 1)
return (NNreg)
}
NNpredict.AMORE <- function(object, x, ...)
AMORE::sim.MLPnet(object$net, x)
NNclose.AMORE <- function()
if("package:AMORE" %in% search())
detach("package:AMORE", unload=TRUE)
AMORE.method <- c("ADAPTgd", "ADAPTgdwm", "BATCHgd", "BATCHgdwm")
AMORE.prepareZZ <- list(xdmv = "d", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, AMORE.method, "NNtrain.AMORE", "hyperParams.AMORE", "NNpredict.AMORE",
NNsummary, "NNclose.AMORE", NA, AMORE.prepareZZ, nrep=2, echo=TRUE,
doplot=FALSE, echoreport=0,
pkgname="AMORE", pkgfun="train", rdafile=TRUE, odir=odir)#library(ANN2)
ANN2.method <- c("sgd", "rmsprop")
hyperParams.ANN2 <- function(optim_method) {
if (!is.element(optim_method, c("sgd", "adam", "rmsprop"))) stop("Invalid Parameters.")
if (optim_method == "sgd") { iter <- 4000; lr <- 0.001}
if (optim_method == "adam") { iter <- 3000; lr <- 0.007}
if (optim_method == "rmsprop") { iter <- 3000; lr <- 0.005}
params <- paste0("method=", optim_method, "_", "lr=", lr, "_", "iter=", iter)
out <- list(iter = iter, lr = lr, params = params)
return (out)
}
NNtrain.ANN2 <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams, ...){
hyper_params <- do.call(hyperParams, list(optim_method, ...))
iter <- hyper_params$iter
lr <- hyper_params$lr
NNreg <- ANN2::neuralnetwork(X = x, y = y,
val.prop = 0,
standardize = FALSE,
hidden.layers = c(hidden_neur),
regression = TRUE,
loss.type = "squared",
n.epochs = iter,
optim.type = optim_method,
learn.rates = lr,
verbose = FALSE,
random.seed = as.integer(runif(1)*10000000))
return (NNreg)
}
NNpredict.ANN2 <- function(object, x, ...)
predict(object, x)$predictions
NNclose.ANN2 <- function()
if("package:ANN2" %in% search())
detach("package:ANN2", unload=TRUE)
ANN2.prepareZZ <- list(xdmv = "d", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, ANN2.method, "NNtrain.ANN2", "hyperParams.ANN2", "NNpredict.ANN2",
NNsummary, "NNclose.ANN2", NA, ANN2.prepareZZ, nrep=2, echo=TRUE, doplot=FALSE,
pkgname="ANN2", pkgfun="neuralnetwork", rdafile=TRUE, odir=odir)#library(automl)
automl.method <- c("trainwgrad", "trainwpso")
hyperParams.automl <- function(optim_method, ...) {
if (!is.element(optim_method, c("trainwgrad", "trainwpso"))) stop("Invalid Parameters.")
hidden_activation = "tanh"
params <- paste0("method=", optim_method, "_", "hidden_activation=", hidden_activation)
out <- list(hidden_activation = hidden_activation, params = params)
return (out)
}
NNtrain.automl <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
hidden_activation <- hyper_params$hidden_activation
# NNreg <- automl::automl_train(Xref = x, Yref = y)
NNreg <- automl::automl_train_manual(Xref = x, Yref = y,
hpar = list(modexec = optim_method,
layersshape = c(hidden_neur, 0),
layersacttype = c(hidden_activation, ""),
verbose = FALSE,
seed = as.integer(runif(1)*10000000)))
return (NNreg)
}
NNpredict.automl <- function(object, x, ...)
automl::automl_predict(model=object, X=x)
NNclose.automl <- function()
if("package:automl" %in% search())
detach("package:automl", unload=TRUE)
automl.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, automl.method, "NNtrain.automl", "hyperParams.automl", "NNpredict.automl",
NNsummary, "NNclose.automl", NA, automl.prepareZZ, nrep=5, echo=TRUE, doplot=FALSE,
pkgname="automl", pkgfun="automl_train_manual", rdafile=TRUE, odir=odir)#library(brnn)
brnn.method <- "gaussNewton"
hyperParams.brnn <- function(optim_method, ...) {
if (!is.element(optim_method, c("gaussNewton"))) stop("Invalid Parameters.")
iter <- 80
params <- paste0("method=", optim_method, "_iter=", iter)
out <- list(iter = iter, params = params)
return (out)
}
NNtrain.brnn <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams,...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
iter <- hyper_params$iter
NNreg <- brnn::brnn(x, y, hidden_neur, normalize = FALSE, epochs = iter, verbose = FALSE)
return (NNreg)
}
NNpredict.brnn <- function(object, x, ...)
predict(object, x)
NNclose.brnn <- function()
if("package:brnn" %in% search())
detach("package:brnn", unload=TRUE)
brnn.prepareZZ <- list(xdmv = "m", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, brnn.method, "NNtrain.brnn", "hyperParams.brnn", "NNpredict.brnn",
NNsummary, "NNclose.brnn", NA, brnn.prepareZZ, nrep=5, echo=TRUE, doplot=FALSE,
pkgname="brnn", pkgfun="brnn", rdafile=TRUE, odir=odir)#library(CaDENCE)
CaDENCE.method <- c("optim", "psoptim", "Rprop")
hyperParams.CaDENCE <- function(optim_method, ...) {
if (!is.element(optim_method, c("nelderMead"))) stop("Invalid Parameters.")
iter = 1000
params <- paste0("method=", optim_method, "_iter=", iter)
out <- list(iter = iter, params = params, maxit.Nelder=1)
return (out)
}
NNtrain.CaDENCE <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams,...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
iter <- hyper_params$iter
NNreg <- CaDENCE::cadence.fit(x = x, y = y,
iter.max = iter,
n.hidden = hidden_neur,
hidden.fcn = tanh,
method = optim_method,
n.trials = 1,
trace = 0,
maxit.Nelder = hyper_params$maxit.Nelder,
f.cost = CaDENCE::cadence.cost)
return (NNreg)
}
NNpredict.CaDENCE <- function(object, x, ...)
CaDENCE::cadence.predict(x = x, fit = object)[,1]
NNclose.CaDENCE <- function()
if("package:CaDENCE" %in% search())
detach("package:CaDENCE", unload=TRUE)
CaDENCE.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, CaDENCE.method, "NNtrain.CaDENCE", "hyperParams.CaDENCE", "NNpredict.CaDENCE",
NNsummary, "NNclose.CaDENCE", NA, CaDENCE.prepareZZ, nrep=2, echo=TRUE, doplot=FALSE,
pkgname="CaDENCE", pkgfun="cadence.fit", rdafile=TRUE, odir=odir)#library(deepnet)
deepnet.method <- "gradientDescent"
hyperParams.deepnet <- function(optim_method, ...) {
if (!is.element(optim_method, c("gradientDescent"))) stop("Invalid Parameters.")
iter <- 11000
lr <- 0.01
dropout <- 0
momentum <- 0.95
hidden_activation <- "sigm"
params <- paste0("method=", optim_method, "_", "iter=", iter, "_", "lr=", lr, "_", "dropout=", dropout, "_", "momentum=", momentum)
out <- list(iter = iter, lr = lr, momentum = momentum, hidden_activation = hidden_activation, dropout = dropout, params = params)
return (out)
}
NNtrain.deepnet <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
iter <- hyper_params$iter
lr <- hyper_params$lr
dropout <- hyper_params$dropout
momentum <- hyper_params$momentum
hidden_activation <- hyper_params$hidden_activation
dropout <- hyper_params$dropout
NNreg <- deepnet::nn.train(x = x, y = y,
hidden = c(hidden_neur),
activationfun = hidden_activation,
learningrate = lr,
output = 'linear',
numepochs = iter,
hidden_dropout = dropout,
momentum = momentum)
return (NNreg)
}
NNpredict.deepnet <- function(object, x, ...)
deepnet::nn.predict(nn = object, x = x)
NNclose.deepnet <- function()
if("package:deepnet" %in% search())
detach("package:deepnet", unload=TRUE)
deepnet.prepareZZ <- list(xdmv = "m", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, CaDENCE.method, "NNtrain.deepnet", "hyperParams.deepnet", "NNpredict.deepnet",
NNsummary, "NNclose.deepnet", NA, deepnet.prepareZZ, nrep=2, echo=TRUE, doplot=FALSE,
pkgname="deepnet", pkgfun="nn.train", rdafile=TRUE, odir=odir)#library(elmNNRcpp)
elmNNRcpp.method <- "extremeML"
hyperParams.elmNNRcpp <- function(optim_method, ...) {
if (!is.element(optim_method, c("extremeML"))) stop("Invalid Parameters.")
iter <- 10
moorep_pseudoinv_tol <- 0.01
wt_init <- "normal_gaussian"
hidden_activation <- "tansig"
params <- paste0("method=", optim_method, "_iter=", iter, "_wtinit=", wt_init, "_hidden_activation", hidden_activation)
out <- list(iter = iter, wt_init = wt_init, hidden_activation = hidden_activation,
params = params, moorep_pseudoinv_tol=moorep_pseudoinv_tol)
return (out)
}
NNtrain.elmNNRcpp <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
iter <- hyper_params$iter
wt_init <- hyper_params$wt_init
hidden_activation <- hyper_params$hidden_activation
moorep_pseudoinv_tol <- hyper_params$moorep_pseudoinv_tol
NNreg <- elmNNRcpp::elm_train(x, y,
nhid = hidden_neur,
actfun=hidden_activation,
init_weights = wt_init,
bias = TRUE,
moorep_pseudoinv_tol = moorep_pseudoinv_tol,
verbose = FALSE,
seed = as.integer(runif(1)*10000000))
return (NNreg)
}
NNpredict.elmNNRcpp <- function(object, x, ...)
elmNNRcpp::elm_predict(elm_train_object = object, newdata = x, normalize = FALSE)
NNclose.elmNNRcpp <- function()
if("package:elmNNRcpp" %in% search())
detach("package:elmNNRcpp", unload=TRUE)
elmNNRcpp.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, elmNNRcpp.method, "NNtrain.elmNNRcpp", "hyperParams.elmNNRcpp", "NNpredict.elmNNRcpp",
NNsummary, "NNclose.elmNNRcpp", NA, elmNNRcpp.prepareZZ, nrep=2, echo=TRUE, doplot=FALSE,
pkgname="elmNNRcpp", pkgfun="elm_train", rdafile=TRUE, odir=odir)ELMR.method <- "extremeML"
hyperParams.ELMR <- function(optim_method, ...) {
if (!is.element(optim_method, c("extremeML"))) stop("Invalid Parameters.")
hidden_activation <- "sig"
size_first_block <- 30
size_each_chunk <- 30
params <- paste0("method=", optim_method, "_hidden_activation=", hidden_activation)
out <- list(hidden_activation = hidden_activation, params = params,
size_first_block=size_first_block, size_each_chunk=size_each_chunk)
return (out)
}
NNtrain.ELMR <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
hidden_activation <- hyper_params$hidden_activation
size_each_chunk <- hyper_params$size_each_chunk
size_first_block <- hyper_params$size_first_block
#OSelm_train.formula() call OSelm_training()
NNreg <- ELMR::OSelm_train.formula(formula = formula,
data = dataxy,
Elm_type = "regression",
nHiddenNeurons = hidden_neur,
ActivationFunction = hidden_activation,
N0 = size_first_block, Block = size_each_chunk)
return (NNreg)
}
NNpredict.ELMR <- function(object, x, xy)
ELMR::predict_elm(model = object, test = xy)$predicted
NNclose.ELMR <- function()
if("package:ELMR" %in% search())
detach("package:ELMR", unload=TRUE)
ELMR.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, ELMR.method, "NNtrain.ELMR", "hyperParams.ELMR", "NNpredict.ELMR",
NNsummary, "NNclose.ELMR", NA, ELMR.prepareZZ, nrep=2, echo=TRUE, doplot=FALSE,
pkgname="ELMR", pkgfun="OSelm_train", rdafile=TRUE, odir=odir)#library(h2o)
h2o.method <- "gradientDescent"
hyperParams.h2o <- function(optim_method, ...) {
if (!is.element(optim_method, c("gradientDescent"))) stop("Invalid Parameters.")
hidden_activation = "Tanh"
iter <- 10000
rate <- 0.01
stopping_rounds <- 500
stopping_tolerance <- 1e-5
distribution <- "gaussian"
params <- paste0("method=", optim_method, "_", "hidden_activation=", hidden_activation)
out <- list(hidden_activation = hidden_activation, iter = iter, params = params,
rate=rate, stopping_rounds=stopping_rounds, stopping_tolerance=stopping_tolerance,
distribution=distribution)
return (out)
}
NNtrain.h2o <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
hidden_activation <- hyper_params$hidden_activation
iter <- hyper_params$iter
rate <- hyper_params$rate
stopping_rounds <- hyper_params$stopping_rounds
stopping_tolerance <- hyper_params$stopping_tolerance
distribution <- hyper_params$distribution
if(class(dataxy) != "H2OFrame")
dataxy <- h2o::as.h2o(dataxy)
NNreg <- h2o::h2o.deeplearning(y = "y",
training_frame = dataxy,
overwrite_with_best_model = TRUE,
standardize = FALSE,
activation = hidden_activation,
adaptive_rate = TRUE,
#rate = rate,
hidden = hidden_neur,
epochs = iter,
train_samples_per_iteration = -1,
initial_weight_distribution = "Normal",
initial_weight_scale = 0.1,
loss = "Quadratic",
distribution = distribution,
stopping_rounds = stopping_rounds,
stopping_metric = "RMSE",
stopping_tolerance = stopping_tolerance,
seed = as.integer(runif(1)*10000000),
verbose = FALSE
)
return (NNreg)
}
NNpredict.h2o <- function(object, x, ...)
{
predictions <- h2o::h2o.predict(object, newdata=h2o::as.h2o(x))
as.data.frame(predictions)$predict
}
NNclose.h2o <- function()
{
h2o::h2o.shutdown(FALSE)
if("package:h2o" %in% search())
detach("package:h2o", unload=TRUE)
}
NNstart.h2o <- function()
{
require("h2o", character.only = TRUE)
h2o::h2o.init()
h2o::h2o.no_progress()
}
h2o.prepareZZ <- list(xdmv = "m", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, h2o.method, "NNtrain.h2o", "hyperParams.h2o", "NNpredict.h2o",
NNsummary, "NNclose.h2o", "NNstart.h2o", h2o.prepareZZ, nrep=5, echo=TRUE, doplot=FALSE,
pkgname="h2o", pkgfun="deeplearning", rdafile=TRUE, odir=odir)#library(keras)
keras.method <- c("adam", "rmsprop", "sgd", "adadelta", "adagrad")
hyperParams.keras <- function(optim_method, ...) {
if (!is.element(optim_method, c("adam", "rmsprop", "sgd", "adagrad", "adadelta")))
stop("Invalid Parameters.")
hidden_activation = "tanh"
iter <- 10000
lr <- 0.001
params <- paste0("method=", optim_method, "_iter=", iter, "_lr=", lr, "_hidden_activation=", hidden_activation)
out <- list(hidden_activation = hidden_activation, iter = iter, lr = lr, params = params)
return (out)
}
NNtrain.keras <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
iter <- hyper_params$iter
early_stop <- callback_early_stopping(monitor = "loss", patience = 20, restore_best_weights = TRUE, mode = "auto", min_delta = 1e-3)
#should we have a higher min_delta
hidden_activation <- hyper_params$hidden_activation
lr <- hyper_params$lr
if (optim_method == "adam") { op <- optimizer_adam(lr = lr)}
if (optim_method == "rmsprop") { op <- optimizer_rmsprop(lr = lr)}
if (optim_method == "adagrad") { op <- optimizer_adagrad(lr = lr)}
if (optim_method == "adadelta") { op <- optimizer_adadelta(lr = lr)}
if (optim_method == "sgd") { op <- optimizer_sgd(lr = lr)}
model <- keras_model_sequential() %>%
layer_dense(units = hidden_neur, activation = hidden_activation, input_shape = ncol(x)) %>%
layer_dense(units = 1)
model %>% compile(
loss = "mse",
optimizer = op,
metrics = list("mean_absolute_error")
)
historylog <- model %>% fit(x, y, epochs = iter, verbose = 0, callbacks = list(early_stop))
return (model)
}
NNpredict.keras <- function(object, x, ...)
{
object %>% predict(x)
}
NNclose.keras <- function()
{
if("package:keras" %in% search())
detach("package:keras", unload=TRUE)
}
keras.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, keras.method, "NNtrain.keras", "hyperParams.keras", "NNpredict.keras",
NNsummary, "NNclose.keras", NA, keras.prepareZZ, nrep=2, echo=TRUE, doplot=FALSE,
pkgname="keras", pkgfun="fit", rdafile=TRUE, odir=odir, echoreport=2)#library(MachineShop)
MachineShop.method <- "none"
hyperParams.MachineShop <- function(...) {
return (list(iter=150, trace=FALSE, linout=TRUE))
}
NNtrain.MachineShop <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(...))
trace <- hyper_params$trace
maxit <- hyper_params$iter
linout <- hyper_params$linout #linearoutpputunit
myNN <- MachineShop::NNetModel(size = hidden_neur, linout = linout, maxit = maxit,
trace=trace)
MachineShop::fit(formula, data = dataxy, model = myNN)
}
NNpredict.MachineShop <- function(object, x, ...)
as.numeric(predict(object, newdata=x, type="response"))
NNclose.MachineShop <- function()
if("package:MachineShop" %in% search())
detach("package:MachineShop", unload=TRUE)
MachineShop.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, MachineShop.method, "NNtrain.MachineShop", "hyperParams.MachineShop", "NNpredict.MachineShop",
NNsummary, "NNclose.MachineShop", NA, MachineShop.prepareZZ, nrep=5,
echo=TRUE, doplot=FALSE, echoreport=0,
pkgname="MachineShop", pkgfun="fit", rdafile=TRUE, odir=odir)#library(minpack.lm)
minpack.lm.method <- "none"
hyperParams.minpack.lm <- function(...) {
return (list(iter=150, sdnormstart=0.1))
}
NNtrain.minpack.lm <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, NNfullformula, NNparam, ...) {
hyper_params <- do.call(hyperParams, list(...))
start <- round(rnorm(NNparam, sd = hyper_params$sdnormstart), 4)
names(start) <- paste0("b", 1:NNparam)
minpack.lm::nlsLM(NNfullformula, data = dataxy, start=start,
control = list(maxiter = hyper_params$iter))
}
NNpredict.minpack.lm <- function(object, x, ...)
predict(object, newdata=as.data.frame(x))
NNclose.minpack.lm <- function()
if("package:minpack.lm" %in% search())
detach("package:minpack.lm", unload=TRUE)
minpack.lm.prepareZZ <- list(xdmv = "m", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, minpack.lm.method, "NNtrain.minpack.lm", "hyperParams.minpack.lm", "NNpredict.minpack.lm",
NNsummary, "NNclose.minpack.lm", NA, minpack.lm.prepareZZ, nrep=5,
echo=TRUE, doplot=FALSE, echoreport=0,
pkgname="minpack.lm", pkgfun="nlsLM", rdafile=TRUE, odir=odir)#library(monmlp)
monmlp.method <- c("BFGS", "Nelder-Mead")
hyperParams.monmlp <- function(...) {
return (list(iter=300, silent=TRUE, scale=TRUE))
}
NNtrain.monmlp <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(...))
monmlp::monmlp.fit(x, y, hidden1 = hidden_neur, scale.y = hyper_params$scale, silent=hyper_params$silent,
method = method, iter.max = hyper_params$iter)
}
NNpredict.monmlp <- function(object, x, ...)
as.numeric(monmlp::monmlp.predict(x, weights=object))
NNclose.monmlp <- function()
if("package:monmlp" %in% search())
detach("package:monmlp", unload=TRUE)
monmlp.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, monmlp.method, "NNtrain.monmlp", "hyperParams.monmlp", "NNpredict.monmlp",
NNsummary, "NNclose.monmlp", NA, monmlp.prepareZZ, nrep=2,
echo=TRUE, doplot=FALSE, echoreport=0,
pkgname="monmlp", pkgfun="monmlp.fit", rdafile=TRUE, odir=odir)#library(neural)
neural.method <- "none"
hyperParams.neural <- function(...) {
return (list(iter=1000, visual=FALSE, alfa=0.9))
}
NNtrain.neural <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(...))
neural::mlptrain(x, neurons = hidden_neur, y, alfa = hyper_params$alfa,
it = hyper_params$iter, visual = hyper_params$visual)
}
NNpredict.neural <- function(object, x, ...)
as.numeric(neural::mlp(x, object$weight, object$dist, object$neurons, object$actfns))
NNclose.neural <- function()
if("package:neural" %in% search())
detach("package:neural", unload=TRUE)
neural.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, neural.method, "NNtrain.neural", "hyperParams.neural", "NNpredict.neural",
NNsummary, "NNclose.neural", NA, neural.prepareZZ, nrep=2,
echo=TRUE, doplot=FALSE, echoreport=0,
pkgname="neural", pkgfun="mlptrain", rdafile=TRUE, odir=odir)#library(neuralnet)
neuralnet.method <- c("slr", "sag", "rprop-", "rprop+", "backprop")
hyperParams.neuralnet <- function(optim_method, ...) {
return (list(iter=1e5, threshold=0.5, linear.output=TRUE))
}
NNtrain.neuralnet <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(...))
neuralnet::neuralnet(formula = formula, data = dataxy, hidden = hidden_neur, algorithm=method,
threshold=hyper_params$threshold, linear.output=hyper_params$linear.output,
stepmax = hyper_params$iter, startweights = NULL, act.fct = "tanh")
}
NNpredict.neuralnet <- function(object, x, ...)
as.numeric(predict(object, newdata = x))
NNclose.neuralnet <- function()
if("package:neuralnet" %in% search())
detach("package:neuralnet", unload=TRUE)
neuralnet.prepareZZ <- list(xdmv = "d", ydmv = "d", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, neuralnet.method, "NNtrain.neuralnet", "hyperParams.neuralnet", "NNpredict.neuralnet",
NNsummary, "NNclose.neuralnet", NA, neuralnet.prepareZZ, nrep=2,
echo=TRUE, doplot=FALSE, echoreport=0,
pkgname="neuralnet", pkgfun="neuralnet", rdafile=TRUE, odir=odir)#library(nlsr)
nlsr.method <- "none"
hyperParams.nlsr <- function(...) {
return (list(iter=150, sdnormstart=0.1))
}
NNtrain.nlsr <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, NNfullformula, NNparam, ...) {
hyper_params <- do.call(hyperParams, list(...))
start <- round(rnorm(NNparam, sd = hyper_params$sdnormstart), 4)
names(start) <- paste0("b", 1:NNparam)
nlsr::nlxb(NNfullformula, start = start, data = dataxy,
control = list(femax = hyper_params$iter))
}
NNpredict.nlsr <- function(object, x, ...)
as.numeric(predict(object, x))
NNclose.nlsr <- function()
if("package:nlsr" %in% search())
detach("package:nlsr", unload=TRUE)
nlsr.prepareZZ <- list(xdmv = "d", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, nlsr.method, "NNtrain.nlsr", "hyperParams.nlsr", "NNpredict.nlsr",
NNsummary, "NNclose.nlsr", NA, nlsr.prepareZZ, nrep=5,
echo=TRUE, doplot=FALSE, echoreport=0,
pkgname="nlsr", pkgfun="nlxb", rdafile=TRUE, odir=odir)#library(nnet)
nnet.method <- "none"
hyperParams.nnet <- function(...) {
return (list(iter=150, trace=FALSE))
}
NNtrain.nnet <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(...))
nnet::nnet(x, y, size = hidden_neur, linout = TRUE, maxit = hyper_params$iter, trace=hyper_params$trace)
}
NNpredict.nnet <- function(object, x, ...)
predict(object, newdata=x)
NNclose.nnet <- function()
if("package:nnet" %in% search())
detach("package:nnet", unload=TRUE)
nnet.prepareZZ <- list(xdmv = "d", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, nnet.method, "NNtrain.nnet", "hyperParams.nnet", "NNpredict.nnet",
NNsummary, "NNclose.nnet", NA, nnet.prepareZZ, nrep=5, echo=TRUE, doplot=FALSE,
pkgname="nnet", pkgfun="nnet", rdafile=TRUE, odir=odir)#library(qrnn)
qrnn.method <- "none"
hyperParams.qrnn <- function(optim_method, ...) {
maxiter <- 700
init.range = c(-0.1, 0.1, -0.1, 0.1)
params <- paste0("method=", optim_method, "_iter=", maxiter)
out <- list(iter = maxiter, params = params, init.range=init.range)
return (out)
}
NNtrain.qrnn <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams,...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
NNreg <- qrnn::qrnn.fit(x, y, n.hidden = hidden_neur,
iter.max = hyper_params$iter, n.trials = 1,
init.range = hyper_params$init.range, trace=FALSE)
return (NNreg)
}
NNpredict.qrnn <- function(object, x, ...)
qrnn::qrnn.predict(x, object)
NNclose.qrnn <- function()
if("package:qrnn" %in% search())
detach("package:qrnn", unload=TRUE)
qrnn.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, qrnn.method, "NNtrain.qrnn", "hyperParams.qrnn", "NNpredict.qrnn",
NNsummary, "NNclose.qrnn", NA, qrnn.prepareZZ, nrep=5, echo=TRUE, doplot=FALSE,
pkgname="qrnn", pkgfun="qrnn.fit", rdafile=TRUE, odir=odir)#library(radiant.model)
radiant.model.method <- "none"
hyperParams.radiant.model <- function(...) {
return (list(type="regression", decay=0))
}
NNtrain.radiant.model <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(...))
radiant.model::nn(dataxy, rvar = "y", evar = attr(terms(formula), "term.labels"),
type = hyper_params$type, size = hidden_neur,
decay = hyper_params$decay)
}
NNpredict.radiant.model <- function(object, x, ...)
predict(object, pred_data=as.data.frame(x))$Prediction
NNclose.radiant.model <- function()
if("package:radiant.model" %in% search())
detach("package:radiant.model", unload=TRUE)
radiant.model.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, radiant.model.method, "NNtrain.radiant.model", "hyperParams.radiant.model", "NNpredict.radiant.model",
NNsummary, "NNclose.radiant.model", NA, radiant.model.prepareZZ, nrep=5,
echo=TRUE, doplot=FALSE, echoreport=0,
pkgname="radiant.model", pkgfun="nn", rdafile=TRUE, odir=odir)#library(rcane)
rcane.method <- c("bgd", "sgd", "cd", "mini-bgd")
hyperParams.rcane <- function(...) {
return (list(iter=1000, alpha=0.1))
}
NNtrain.rcane <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, NNfullformula, NNparam, ...) {
hyper_params <- do.call(hyperParams, list(...))
rcane::rlm(formula, dataxy, method = method, alpha = hyper_params$alpha, max.iter = hyper_params$iter)
}
NNpredict.rcane <- function(object, x, ...)
as.numeric(rcane:::predict.rlmmodel(object, x))
NNclose.rcane <- function()
if("package:rcane" %in% search())
detach("package:rcane", unload=TRUE)
rcane.prepareZZ <- list(xdmv = "d", ydmv = "d", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, rcane.method, "NNtrain.rcane", "hyperParams.rcane", "NNpredict.rcane",
NNsummary, "NNclose.rcane", NA, rcane.prepareZZ, nrep=5,
echo=TRUE, doplot=FALSE, echoreport=0,
pkgname="rcane", pkgfun="rlm", rdafile=TRUE, odir=odir)#library(rminer)
rminer.method <- "none"
hyperParams.rminer <- function(...) {
return (list(task="reg", iter=150))
}
NNtrain.rminer <- function(x, y, dataxy, formula, hidden_neur, method, hyperParams, ...) {
hyper_params <- do.call(hyperParams, list(...))
rminer::fit(formula, data = dataxy, model = "mlp", task = hyper_params$task,
size = hidden_neur, maxit = hyper_params$iter)
}
NNpredict.rminer <- function(object, x, ...)
as.numeric(rminer::predict(object, newdata=as.data.frame(x)))
NNclose.rminer <- function()
if("package:rminer" %in% search())
detach("package:rminer", unload=TRUE)
rminer.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, rminer.method, "NNtrain.rminer", "hyperParams.rminer", "NNpredict.rminer",
NNsummary, "NNclose.rminer", NA, rminer.prepareZZ, nrep=2,
echo=TRUE, doplot=FALSE, echoreport=0,
pkgname="rminer", pkgfun="fit", rdafile=TRUE, odir=odir)#library(RSNNS)
RSNNS.method <- c("Rprop","BackpropBatch","BackpropChunk","BackpropMomentum",
"BackpropWeightDecay","Quickprop","SCG","Std_Backpropagation")
hyperParams.RSNNS <- function(optim_method, ...) {
if(optim_method %in% c("Rprop","BackpropChunk","BackpropMomentum","BackpropWeightDecay","SCG","Std_Backpropagation"))
maxiter <- 1000
else
maxiter <- 10000
params <- paste0("method=", optim_method, "_iter=", maxiter)
out <- list(iter = maxiter, sdnormstart=0.1)
return (out)
}
NNtrain.RSNNS <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams, NNfullformula, NNparam,...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
start <- round(rnorm(NNparam, sd = hyper_params$sdnormstart), 4)
names(start) <- paste0("b", 1:NNparam)
NNreg <- RSNNS::mlp(x, y, initFuncParams = start,
size = hidden_neur, learnFunc = optim_method,
maxit = hyper_params$iter, linOut = TRUE)
return (NNreg)
}
NNpredict.RSNNS <- function(object, x, ...)
predict(object, x)
NNclose.RSNNS <- function()
if("package:RSNNS" %in% search())
detach("package:RSNNS", unload=TRUE)
RSNNS.prepareZZ <- list(xdmv = "m", ydmv = "m", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, RSNNS.method, "NNtrain.RSNNS", "hyperParams.RSNNS", "NNpredict.RSNNS",
NNsummary, "NNclose.RSNNS", NA, RSNNS.prepareZZ, nrep=5, echo=TRUE, doplot=FALSE,
pkgname="RSNNS", pkgfun="mlp", rdafile=TRUE, odir=odir)simpleNeural.method <- "none"
hyperParams.simpleNeural <- function(optim_method, ...) {
maxiter <- 1000
params <- paste0("method=", optim_method, "_iter=", maxiter)
out <- list(iter = maxiter, alpha=0.001, params = params, lambda=0.5)
return (out)
}
NNtrain.simpleNeural <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams,...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
NNreg <- simpleNeural::sN.MLPtrain(x, y, hidden_layer_size = hidden_neur, it = hyper_params$iter,
lambda = hyper_params$lambda, alpha = hyper_params$alpha)
return (NNreg)
}
NNpredict.simpleNeural <- function(object, x, ...)
simpleNeural::sN.MLPpredict(nnModel = object, X = x, raw = FALSE)
NNclose.simpleNeural <- function()
if("package:simpleNeural" %in% search())
detach("package:simpleNeural", unload=TRUE)
simpleNeural.prepareZZ <- list(xdmv = "m", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, simpleNeural.method, "NNtrain.simpleNeural", "hyperParams.simpleNeural", "NNpredict.simpleNeural",
NNsummary, "NNclose.simpleNeural", NA, simpleNeural.prepareZZ, nrep=1, echo=TRUE, doplot=FALSE,
pkgname="simpleNeural", pkgfun="sN.MLPtrain", rdafile=TRUE, odir=odir, echoreport=1)snnR.method <- "none"
hyperParams.snnR <- function(optim_method, ...) {
maxiter <- 200
params <- paste0("method=", optim_method, "_iter=", maxiter)
out <- list(iter = maxiter, params = params)
return (out)
}
NNtrain.snnR <- function(x, y, dataxy, formula, hidden_neur, optim_method, hyperParams,...) {
hyper_params <- do.call(hyperParams, list(optim_method, ...))
NNreg <- snnR::snnR(x, y, nHidden = as.matrix(hidden_neur),
iteramax = hyper_params$iter, verbose=FALSE)
return (NNreg)
}
NNpredict.snnR <- function(object, x, ...)
predict(object, x)
NNclose.snnR <- function()
if("package:snnR" %in% search())
detach("package:snnR", unload=TRUE)
snnR.prepareZZ <- list(xdmv = "m", ydmv = "v", zdm = "d", scale = TRUE)
if(FALSE)
res <- train_and_predict_1data(1, simpleNeural.method, "NNtrain.snnR", "hyperParams.snnR", "NNpredict.snnR",
NNsummary, "NNclose.snnR", NA, simpleNeural.prepareZZ, nrep=5, echo=TRUE, doplot=FALSE,
pkgname="snnR", pkgfun="snnR", rdafile=TRUE, odir=odir, echoreport=1)Package removed from CRAN
methodlist <- list(AMORE.method, automl.method,
brnn.method, CaDENCE.method,
deepnet.method, elmNNRcpp.method,
ELMR.method, h2o.method,
keras.method, MachineShop.method,
minpack.lm.method, monmlp.method,
neural.method, neuralnet.method,
nlsr.method, nnet.method,
qrnn.method,
radiant.model.method, rcane.method,
rminer.method, RSNNS.method,
simpleNeural.method, snnR.method)
pkgfunmat <- rbind(c("AMORE", "train"),
c("automl", "automl_train_manual"),
c("brnn", "brnn"),
c("CaDENCE", "cadence.fit"),
c("deepnet", "nn.train"),
c("elmNNRcpp", "elm_train"),
c("ELMR", "OSelm_train"),
c("h2o", "deeplearning"),
c("keras", "fit"),
c("MachineShop", "fit"),
c("minpack.lm", "nlsLM"),
c("monmlp", "monmlp.fit"),
c("neural", "mlptrain"),
c("neuralnet", "neuralnet"),
c("nlsr", "nlxb"),
c("nnet", "nnet"),
c("qrnn", "qrnn.fit"),
c("radiant.model", "nn"),
c("rcane", "rlm"),
c("rminer", "fit"),
c("RSNNS", "mlp"),
c("simpleNeural", "sN.MLPtrain"),
c("snnR", "snnR"))
colnames(pkgfunmat) <- c("pkg", "fun")
trainvect <- paste("NNtrain", pkgfunmat[,"pkg"], sep=".")
hypervect <- paste("hyperParams", pkgfunmat[,"pkg"], sep=".")
predvect <- paste("NNpredict", pkgfunmat[,"pkg"], sep=".")
#close function is only needed for h2o
closevect <- paste("NNclose", pkgfunmat[,"pkg"], sep=".")
startvect <- rep(NA, length(pkgfunmat[,"pkg"]))
startvect[pkgfunmat[,"pkg"] == "h2o"] <- "NNstart.h2o"
preparelist <- list(AMORE.prepareZZ, automl.prepareZZ,
brnn.prepareZZ, CaDENCE.prepareZZ,
deepnet.prepareZZ, elmNNRcpp.prepareZZ,
ELMR.prepareZZ, h2o.prepareZZ,
keras.prepareZZ, MachineShop.prepareZZ,
minpack.lm.prepareZZ, monmlp.prepareZZ,
neural.prepareZZ, neuralnet.prepareZZ,
nlsr.prepareZZ, nnet.prepareZZ,
qrnn.prepareZZ,
radiant.model.prepareZZ, rcane.prepareZZ,
rminer.prepareZZ, RSNNS.prepareZZ,
simpleNeural.prepareZZ, snnR.prepareZZ)
names(preparelist) <- pkgfunmat[,"pkg"]
#print(cbind(pkgfunmat, startvect))
resall <- train_and_predict_1data(dset=1, method=methodlist, train=trainvect, hyper=hypervect,
pred=predvect, summary=NNsummary, close=closevect,
start=startvect, prepare=preparelist, nrep=5, echo=TRUE, doplot=FALSE,
pkgname=pkgfunmat[,"pkg"], pkgfun=pkgfunmat[,"fun"], rdafile=TRUE, odir=odir)## ________________________________________________________________________________
## *** mDette_AMORE::train_ADAPTgd ***
## AMORE train ADAPTgd i 5 summary statistics 1.3742 1 5.4088 time 0.67
##
## ________________________________________________________________________________
## *** mDette_AMORE::train_ADAPTgdwm ***
## AMORE train ADAPTgdwm i 5 summary statistics 0.3746 0.2876 1.5224 time 0.69
##
## ________________________________________________________________________________
## *** mDette_AMORE::train_BATCHgd ***
## AMORE train BATCHgd i 5 summary statistics 3.4657 2.4655 17.0061 time 2.43
##
## ________________________________________________________________________________
## *** mDette_AMORE::train_BATCHgdwm ***
## AMORE train BATCHgdwm i 5 summary statistics 3.3449 2.4281 17.2335 time 3.04
##
## ________________________________________________________________________________
## *** mDette_automl::automl_train_manual_trainwgrad ***
## automl automl_train_manual trainwgrad i 5 summary statistics 4.2297 2.9791 22.042 time 1.93
##
## ________________________________________________________________________________
## *** mDette_automl::automl_train_manual_trainwpso ***
## automl automl_train_manual trainwpso i 5 summary statistics 5.643 4.358 27.8082 time 3.7
##
## ________________________________________________________________________________
## *** mDette_brnn::brnn_gaussNewton ***
## Number of parameters (weights and biases) to estimate: 25
## Nguyen-Widrow method
## Scaling factor= 0.7022568
## gamma= 20.856 alpha= 0.1242 beta= 6.8337
## Number of parameters (weights and biases) to estimate: 25
## Nguyen-Widrow method
## Scaling factor= 0.7022568
## gamma= 23.6851 alpha= 0.0831 beta= 8.8259
## Number of parameters (weights and biases) to estimate: 25
## Nguyen-Widrow method
## Scaling factor= 0.7022568
## gamma= 21.8364 alpha= 0.1311 beta= 7.2528
## Number of parameters (weights and biases) to estimate: 25
## Nguyen-Widrow method
## Scaling factor= 0.7022568
## gamma= 21.8607 alpha= 0.1208 beta= 7.3448
## Number of parameters (weights and biases) to estimate: 25
## Nguyen-Widrow method
## Scaling factor= 0.7022568
## gamma= 20.6376 alpha= 0.1732 beta= 6.6939
## brnn brnn gaussNewton i 5 summary statistics 2.1873 1.5058 13.7838 time 0.1
##
## ________________________________________________________________________________
## *** mDette_CaDENCE::cadence.fit_optim ***
## CaDENCE cadence.fit optim i 5 summary statistics 8.1656 6.5262 36.2385 time 0.01
##
## ________________________________________________________________________________
## *** mDette_CaDENCE::cadence.fit_psoptim ***
## CaDENCE cadence.fit psoptim i 5 summary statistics 8.1656 6.5262 36.2385 time 0
##
## ________________________________________________________________________________
## *** mDette_CaDENCE::cadence.fit_Rprop ***
## CaDENCE cadence.fit Rprop i 5 summary statistics 8.1656 6.5262 36.2385 time 0.01
##
## ________________________________________________________________________________
## *** mDette_deepnet::nn.train_gradientDescent ***
## deepnet nn.train gradientDescent i 5 summary statistics 1.8569 1.4527 9.9249 time 30.02
##
## ________________________________________________________________________________
## *** mDette_elmNNRcpp::elm_train_extremeML ***
## elmNNRcpp elm_train extremeML i 5 summary statistics 7.3381 5.6126 32.6664 time 0.01
##
## ________________________________________________________________________________
## *** mDette_ELMR::OSelm_train_extremeML ***
## ELMR OSelm_train extremeML i 5 summary statistics 7.4884 6.0846 28.8361 time 0.02
##
##
## H2O is not running yet, starting it now...
##
## Note: In case of errors look at the following log files:
## /var/folders/0_/pj8gdbp16vq_bxhn09k5n4_m0000gp/T//RtmpnZ4OeI/h2o_dutang_started_from_r.out
## /var/folders/0_/pj8gdbp16vq_bxhn09k5n4_m0000gp/T//RtmpnZ4OeI/h2o_dutang_started_from_r.err
##
##
## Starting H2O JVM and connecting: .. Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 2 seconds 603 milliseconds
## H2O cluster timezone: Europe/Paris
## H2O data parsing timezone: UTC
## H2O cluster version: 3.26.0.11
## H2O cluster version age: 2 months and 18 days
## H2O cluster name: H2O_started_from_R_dutang_jsz505
## H2O cluster total nodes: 1
## H2O cluster total memory: 1.78 GB
## H2O cluster total cores: 4
## H2O cluster allowed cores: 4
## H2O cluster healthy: TRUE
## H2O Connection ip: localhost
## H2O Connection port: 54321
## H2O Connection proxy: NA
## H2O Internal Security: FALSE
## H2O API Extensions: Amazon S3, XGBoost, Algos, AutoML, Core V3, TargetEncoder, Core V4
## R Version: R version 3.6.2 (2019-12-12)
##
## ________________________________________________________________________________
## *** mDette_h2o::deeplearning_gradientDescent ***
## h2o deeplearning gradientDescent i 5 summary statistics 0.3384 0.2532 1.4002 time 7.01
##
## [1] "A shutdown has been triggered. "
## ________________________________________________________________________________
## *** mDette_keras::fit_adam ***
## keras fit adam i 5 summary statistics 1.9746 1.274 13.0069 time 28.1
##
## ________________________________________________________________________________
## *** mDette_keras::fit_rmsprop ***
## keras fit rmsprop i 5 summary statistics 2.4147 1.6941 15.3984 time 26.09
##
## ________________________________________________________________________________
## *** mDette_keras::fit_sgd ***
## keras fit sgd i 5 summary statistics 2.7212 1.9676 14.6253 time 61.87
##
## ________________________________________________________________________________
## *** mDette_keras::fit_adadelta ***
## keras fit adadelta i 5 summary statistics 8.2306 6.6805 35.6732 time 100.48
##
## ________________________________________________________________________________
## *** mDette_keras::fit_adagrad ***
## keras fit adagrad i 5 summary statistics 7.7521 6.2533 30.992 time 67.79
##
## ________________________________________________________________________________
## *** mDette_MachineShop::fit_none ***
## MachineShop fit none i 5 summary statistics 0.9512 0.7367 6.7037 time 0.04
##
## ________________________________________________________________________________
## *** mDette_minpack.lm::nlsLM_none ***
## minpack.lm nlsLM none i 5 summary statistics 2.004 1.4739 11.6113 time 0.56
##
## ________________________________________________________________________________
## *** mDette_monmlp::monmlp.fit_BFGS ***
## monmlp monmlp.fit BFGS i 5 summary statistics 1.5408 1.3078 5.157 time 0.41
##
## ________________________________________________________________________________
## *** mDette_monmlp::monmlp.fit_Nelder-Mead ***
## monmlp monmlp.fit Nelder-Mead i 5 summary statistics 7.9383 6.3129 34.106 time 0.33
##
## ________________________________________________________________________________
## *** mDette_neural::mlptrain_none ***
## neural mlptrain none i 5 summary statistics 5.9627 4.4281 28.0647 time 114.62
##
## ________________________________________________________________________________
## *** mDette_neuralnet::neuralnet_slr ***
## neuralnet neuralnet slr i 5 summary statistics 0.7665 0.574 3.942 time 0.82
##
## ________________________________________________________________________________
## *** mDette_neuralnet::neuralnet_sag ***
## Error in cbind(1, pred) %*% weights[[num_hidden_layers + 1]] :
## nécessite des arguments numériques/complexes matrice/vecteur
## Error in cbind(1, pred) %*% weights[[num_hidden_layers + 1]] :
## nécessite des arguments numériques/complexes matrice/vecteur
## neuralnet neuralnet sag i 5 summary statistics 2.1613 1.5106 12.7597 time 10.73
##
## ________________________________________________________________________________
## *** mDette_neuralnet::neuralnet_rprop- ***
## neuralnet neuralnet rprop- i 5 summary statistics 0.8121 0.617 3.9642 time 0.22
##
## ________________________________________________________________________________
## *** mDette_neuralnet::neuralnet_rprop+ ***
## Error in cbind(1, pred) %*% weights[[num_hidden_layers + 1]] :
## nécessite des arguments numériques/complexes matrice/vecteur
## neuralnet neuralnet rprop+ i 5 summary statistics 0.6215 0.4546 3.5013 time 0.25
##
## ________________________________________________________________________________
## *** mDette_neuralnet::neuralnet_backprop ***
## neuralnet neuralnet backprop i 5 summary statistics 8.1656 6.5262 36.2385 time 0
##
## ________________________________________________________________________________
## *** mDette_nlsr::nlxb_none ***
## vn: [1] "y" "b1" "b2" "b3" "b4" "x1" "b5" "x2" "b6" "x3" "b7"
## [12] "b8" "b9" "b10" "b11" "b12" "b13" "b14" "b15" "b16" "b17" "b18"
## [23] "b19" "b20" "b21" "b22" "b23" "b24" "b25" "b26"
## no weights
## vn: [1] "y" "b1" "b2" "b3" "b4" "x1" "b5" "x2" "b6" "x3" "b7"
## [12] "b8" "b9" "b10" "b11" "b12" "b13" "b14" "b15" "b16" "b17" "b18"
## [23] "b19" "b20" "b21" "b22" "b23" "b24" "b25" "b26"
## no weights
## vn: [1] "y" "b1" "b2" "b3" "b4" "x1" "b5" "x2" "b6" "x3" "b7"
## [12] "b8" "b9" "b10" "b11" "b12" "b13" "b14" "b15" "b16" "b17" "b18"
## [23] "b19" "b20" "b21" "b22" "b23" "b24" "b25" "b26"
## no weights
## vn: [1] "y" "b1" "b2" "b3" "b4" "x1" "b5" "x2" "b6" "x3" "b7"
## [12] "b8" "b9" "b10" "b11" "b12" "b13" "b14" "b15" "b16" "b17" "b18"
## [23] "b19" "b20" "b21" "b22" "b23" "b24" "b25" "b26"
## no weights
## vn: [1] "y" "b1" "b2" "b3" "b4" "x1" "b5" "x2" "b6" "x3" "b7"
## [12] "b8" "b9" "b10" "b11" "b12" "b13" "b14" "b15" "b16" "b17" "b18"
## [23] "b19" "b20" "b21" "b22" "b23" "b24" "b25" "b26"
## no weights
## nlsr nlxb none i 5 summary statistics 0.7495 0.5957 4.2779 time 0.5
##
## ________________________________________________________________________________
## *** mDette_nnet::nnet_none ***
## nnet nnet none i 5 summary statistics 0.3561 0.2734 1.343 time 0.04
##
## ________________________________________________________________________________
## *** mDette_qrnn::qrnn.fit_none ***
## qrnn qrnn.fit none i 5 summary statistics 2.4559 1.192 16.3531 time 1.08
##
## ________________________________________________________________________________
## *** mDette_radiant.model::nn_none ***
## radiant.model nn none i 5 summary statistics 0.0963 0.0757 0.363 time 0.59
##
## ________________________________________________________________________________
## *** mDette_rcane::rlm_bgd ***
## rcane rlm bgd i 5 summary statistics 7.6601 6.1945 29.0568 time 0.17
##
## ________________________________________________________________________________
## *** mDette_rcane::rlm_sgd ***
## rcane rlm sgd i 5 summary statistics 7.6602 6.1916 29.1057 time 5.74
##
## ________________________________________________________________________________
## *** mDette_rcane::rlm_cd ***
## rcane rlm cd i 5 summary statistics 7.6601 6.1945 29.0568 time 0.45
##
## ________________________________________________________________________________
## *** mDette_rcane::rlm_mini-bgd ***
## rcane rlm mini-bgd i 5 summary statistics 7.6602 6.1921 29.1025 time 0.25
##
## ________________________________________________________________________________
## *** mDette_rminer::fit_none ***
## rminer fit none i 5 summary statistics 0.7053 0.5377 3.6782 time 0.12
##
## ________________________________________________________________________________
## *** mDette_RSNNS::mlp_Rprop ***
## RSNNS mlp Rprop i 5 summary statistics 1.297 0.9599 7.9278 time 0.89
##
## ________________________________________________________________________________
## *** mDette_RSNNS::mlp_BackpropBatch ***
## RSNNS mlp BackpropBatch i 5 summary statistics 2.1895 1.5403 13.3977 time 9.3
##
## ________________________________________________________________________________
## *** mDette_RSNNS::mlp_BackpropChunk ***
## RSNNS mlp BackpropChunk i 5 summary statistics 0.6841 0.4933 3.096 time 0.94
##
## ________________________________________________________________________________
## *** mDette_RSNNS::mlp_BackpropMomentum ***
## RSNNS mlp BackpropMomentum i 5 summary statistics 0.7226 0.5731 3.306 time 0.89
##
## ________________________________________________________________________________
## *** mDette_RSNNS::mlp_BackpropWeightDecay ***
## RSNNS mlp BackpropWeightDecay i 5 summary statistics 0.8016 0.5914 3.6305 time 0.91
##
## ________________________________________________________________________________
## *** mDette_RSNNS::mlp_Quickprop ***
## RSNNS mlp Quickprop i 5 summary statistics 7.6114 6.2686 29.6111 time 13.86
##
## ________________________________________________________________________________
## *** mDette_RSNNS::mlp_SCG ***
## RSNNS mlp SCG i 5 summary statistics 0.4536 0.341 2.0867 time 1.58
##
## ________________________________________________________________________________
## *** mDette_RSNNS::mlp_Std_Backpropagation ***
## RSNNS mlp Std_Backpropagation i 5 summary statistics 0.6909 0.5549 2.6609 time 0.89
##
## ________________________________________________________________________________
## *** mDette_simpleNeural::sN.MLPtrain_none ***
## simpleNeural sN.MLPtrain none i 5 summary statistics 8.1656 6.5262 36.2385 time 0
##
## ________________________________________________________________________________
## *** mDette_snnR::snnR_none ***
## snnR snnR none i 5 summary statistics 1.9864 1.5889 8.8501 time 0.21write.csv(resall, file=paste0(odir, "results.csv"))
kable(t(resall))| RMSE | MAE | WAE | time | |
|---|---|---|---|---|
| AMORE::ADAPTgd | 1.3624 | 0.9881 | 5.3848 | 0.68 |
| AMORE::ADAPTgdwm | 0.3746 | 0.2876 | 1.5224 | 0.69 |
| AMORE::BATCHgd | 3.0511 | 2.1616 | 18.3031 | 2.47 |
| AMORE::BATCHgdwm | 3.3449 | 2.4281 | 17.2335 | 3.04 |
| automl::trainwgrad | 3.8395 | 2.5817 | 21.2338 | 1.93 |
| automl::trainwpso | 5.6430 | 4.3580 | 27.8082 | 3.70 |
| brnn::gaussNewton | 1.8989 | 1.5214 | 8.5132 | 0.11 |
| CaDENCE::optim | 8.1656 | 6.5262 | 36.2385 | 0.00 |
| CaDENCE::psoptim | 8.1656 | 6.5262 | 36.2385 | 0.00 |
| CaDENCE::Rprop | 8.1656 | 6.5262 | 36.2385 | 0.00 |
| deepnet::gradientDescent | 0.4007 | 0.3005 | 1.7171 | 30.46 |
| elmNNRcpp::extremeML | 7.2581 | 5.5304 | 34.2325 | 0.00 |
| ELMR::extremeML | 7.2757 | 5.8051 | 28.5859 | 0.03 |
| h2o::gradientDescent | 0.3211 | 0.2548 | 1.2478 | 7.11 |
| keras::adam | 0.8762 | 0.6439 | 4.9265 | 43.61 |
| keras::rmsprop | 0.8984 | 0.6845 | 4.6259 | 46.78 |
| keras::sgd | 2.7212 | 1.9676 | 14.6253 | 61.87 |
| keras::adadelta | 8.0719 | 6.2707 | 37.4405 | 334.29 |
| keras::adagrad | 7.4093 | 5.7902 | 30.6360 | 65.71 |
| MachineShop::none | 0.3558 | 0.2731 | 1.3240 | 0.05 |
| minpack.lm::none | 0.1130 | 0.0891 | 0.4710 | 0.32 |
| monmlp::BFGS | 0.3518 | 0.2711 | 1.5437 | 0.43 |
| monmlp::Nelder-Mead | 7.9383 | 6.3129 | 34.1060 | 0.33 |
| neural::none | 5.9627 | 4.4281 | 28.0647 | 114.62 |
| neuralnet::slr | 0.7665 | 0.5740 | 3.9420 | 0.82 |
| neuralnet::sag | 0.5782 | 0.4510 | 2.6256 | 17.08 |
| neuralnet::rprop- | 0.5576 | 0.3943 | 2.9319 | 0.20 |
| neuralnet::rprop+ | 0.6215 | 0.4546 | 3.5013 | 0.25 |
| neuralnet::backprop | 8.1656 | 6.5262 | 36.2385 | 0.01 |
| nlsr::none | 0.3538 | 0.2728 | 1.3215 | 0.75 |
| nnet::none | 0.3069 | 0.2357 | 1.3554 | 0.04 |
| qrnn::none | 0.0756 | 0.0566 | 0.3971 | 0.61 |
| radiant.model::none | 0.0803 | 0.0640 | 0.3281 | 0.77 |
| rcane::bgd | 7.6601 | 6.1945 | 29.0568 | 0.32 |
| rcane::sgd | 7.6602 | 6.1916 | 29.1057 | 5.79 |
| rcane::cd | 7.6601 | 6.1945 | 29.0568 | 0.70 |
| rcane::mini-bgd | 7.6602 | 6.1921 | 29.1025 | 0.27 |
| rminer::none | 0.3366 | 0.2605 | 1.4914 | 0.13 |
| RSNNS::Rprop | 0.6181 | 0.4529 | 3.3812 | 0.92 |
| RSNNS::BackpropBatch | 1.3548 | 0.9194 | 9.5130 | 9.29 |
| RSNNS::BackpropChunk | 0.6841 | 0.4933 | 3.0960 | 0.94 |
| RSNNS::BackpropMomentum | 0.5976 | 0.4492 | 2.6342 | 0.89 |
| RSNNS::BackpropWeightDecay | 0.6384 | 0.5051 | 2.4278 | 1.16 |
| RSNNS::Quickprop | 7.2828 | 5.8912 | 29.6111 | 13.38 |
| RSNNS::SCG | 0.4536 | 0.3410 | 2.0867 | 1.58 |
| RSNNS::Std_Backpropagation | 0.6802 | 0.5218 | 2.8977 | 1.21 |
| simpleNeural::none | 8.1656 | 6.5262 | 36.2385 | 0.00 |
| snnR::none | 0.8399 | 0.6390 | 3.7672 | 0.14 |