NNbenchmark | elmNNRcpp

library(NNbenchmark)
library(elmNNRcpp)

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("extremeML"))) stop("Invalid Parameters.")

    iter   <- 10
    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)
    
    return (out)
}



NNtrain <- function(x, y, hidden_neur, optim_method) {
    
    hyper_params <- hyperParams(optim_method)
    
    iter <- hyper_params$iter
    wt_init <- hyper_params$wt_init
    hidden_activation <- hyper_params$hidden_activation

    NNreg <- elmNNRcpp::elm_train(x, y, 
                                  nhid = hidden_neur, 
                                  actfun=hidden_activation, 
                                  init_weights = wt_init, 
                                  bias = TRUE, 
                                  moorep_pseudoinv_tol = 0.01, 
                                  verbose = FALSE,
                                  seed = as.integer(runif(1)*10000000))
    
    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 = "m", 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("extremeML")
        
    for (m in method) {
        
        descr  <- paste(dset, "elmNNRcpp::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 * elmNNRcpp::elm_predict(elm_train_object = NNreg, newdata = x, normalize = FALSE),
                            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	extremeML	7.2806	7.58001	0.030
mFriedman		0.1596	0.17748	0.013
mIshigami		3.0269	3.21768	0.011
mRef153		10.0896	15.21456	0.014
uDmod1		0.2877	0.34043	0.013
uDmod2		0.2454	0.27959	0.012
uDreyfus1		0.3418	0.51117	0.001
uDreyfus2		0.4115	0.50766	0.002
uGauss1		18.8708	24.69195	0.008
uGauss2		16.3613	19.48198	0.007
uGauss3		17.3151	20.76332	0.003
uNeuroOne		0.8387	0.98444	0.002

clearNN(donotremove)