NNbenchmark | ELMR

library(NNbenchmark)
library(ELMR)

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.")

    hidden_activation <- "sig"

    params <- paste0("method=", optim_method, "_hidden_activation=", hidden_activation)
    
    out <- list(hidden_activation = hidden_activation, params = params)
    
    return (out)
}



NNtrain <- function(x, y, formula, train_data, hidden_neur, optim_method) {
    
    hyper_params <- hyperParams(optim_method)
    
    hidden_activation <- hyper_params$hidden_activation
    
    NNreg <- ELMR::OSelm_train.formula(formula = formula, 
                                       data = train_data, 
                                       Elm_type = "regression", 
                                       nHiddenNeurons = hidden_neur, 
                                       ActivationFunction = hidden_activation, 
                                       N0 = 30, Block = 30)

    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, "ELMR::OSelm_train.formula", 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, formula = fmla, train_data = Zxy, hidden_neur = neur, optim_method = m),
                            error = function(y) {lm(y ~ 0, data = Zxy)}
                          )     
            y_pred     <- tryCatch(
                            ym0 + ysd0 * ELMR::predict_elm(model = NNreg, test = Zxy)$predicted,
                            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	6.1937	7.10045	0.022
mFriedman		0.1556	0.17437	0.015
mIshigami		3.2130	3.26938	0.015
mRef153		8.4055	21.15038	0.011
uDmod1		0.8694	4.82810	0.006
uDmod2		0.7472	3.36431	0.006
uDreyfus1		0.4154	0.58699	0.004
uDreyfus2		0.4357	0.50445	0.004
uGauss1		32.9483	1498.21640	0.010
uGauss2		29.7878	854.59009	0.019
uGauss3		115.8434	1353.93781	0.010
uNeuroOne		0.9769	1.01547	0.003

clearNN(donotremove)