NNbenchmark | tsensembler

0.1 Set Environment

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

0.2 Datasets to Test

NNdataSummary(NNdatasets)

0.3 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 = T)
    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
    iter   <- 150

    descr  <- paste(dset, "tsensembler::bm_ffnn", 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
        NNreg   <- tryCatch(
                            tsensembler::bm_ffnn(fmla, Zxy, list(size = neur, maxit = iter, decay = 0)),
                            error = function(y) {lm(y ~ 0, data = Zxy)}
                          )     
        y_pred  <- tryCatch(
                            ym0 + ysd0*predict(NNreg$nnet_s_30_d_0.01_m_750, 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 = iter, 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)
}

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750 
## nnet_s_30_d_0.01_m_750

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

clearNN(donotremove)