NNbenchmark | deepnet

library(NNbenchmark)
library(deepnet)

library(stringr)
library(dplyr)
library(kableExtra)

0.1 Set Environment

options(scipen = 9999)
options("digits.secs" = 2)
timer  <- createTimer(verbose = FALSE)

0.2 Datasets to Test

NNdataSummary(NNdatasets)

0.3 NN Train Function

hyperParams <- 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 <- function(x, y, hidden_neur, optim_method) {
    
    hyper_params <- hyperParams(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)
}

0.4 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, xdmv = "m", ydmv = "v", zdm = "d", scale = TRUE)
    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("gradientDescent")
        
    for (m in method) {
        
        descr  <- paste(dset, "deepnet::nn.train", 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(x = x, y = y, hidden_neur = neur, optim_method = m),
                            error = function(y) {lm(y ~ 0, data = Zxy)}
                          )     
            y_pred     <- tryCatch(
                            ym0 + ysd0 * deepnet::nn.predict(nn = NNreg, x = x),
                            error = ym0
                          )     
            ####
            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)
}

0.5 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))

0.6 Best Results

dfr %>%
    group_by(dataset, method) %>%
    summarise(minRMSE = min(RMSE), meanRMSE = mean(RMSE), meanTime = mean(Elapsed)) %>%
    kable() %>%
    kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
    collapse_rows(columns = 1:2, valign = "middle")

dataset	method	minRMSE	meanRMSE	meanTime
mDette	gradientDescent	0.3970	0.69902	14.515
mFriedman		0.0183	0.03111	14.615
mIshigami		0.7316	0.93298	15.849
mRef153		3.2794	3.41043	4.089
uDmod1		0.2311	0.29550	1.539
uDmod2		0.2218	0.24446	1.507
uDreyfus1		0.2044	0.24438	1.452
uDreyfus2		0.2049	0.25547	1.452
uGauss1		4.3282	4.87542	4.631
uGauss2		6.0565	6.79120	4.533
uGauss3		3.8553	4.02373	5.811
uNeuroOne		0.2837	0.28482	1.442

clearNN(donotremove)