R/biomod2_classes_0.R

In biomod2: Ensemble Platform for Species Distribution Modeling

## --------------------------------------------------------------------------- #
## 1. BIOMOD.options.default -------------------------------------------------
## --------------------------------------------------------------------------- #

##' @name BIOMOD.options.default
##' @aliases BIOMOD.options.default-class
##' @author Maya Guéguen
##' 
##' @title \code{\link{bm_ModelingOptions}} output object class
##' 
##' @description Class returned by \code{\link{bm_ModelingOptions}} (a 
##' \code{list} of \code{BIOMOD.options.dataset} more exactly), and used by 
##' \code{\link{BIOMOD_Modeling}}
##' 
##' 
##' @param mod a \code{character} corresponding to the model name to be computed, must be either 
##' \code{ANN}, \code{CTA}, \code{DNN}, \code{FDA}, \code{GAM}, \code{GBM}, \code{GLM}, \code{MARS}, 
##' \code{MAXENT}, \code{MAXNET}, \code{RF}, \code{SRE}, \code{XGBOOST}
##' @param typ a \code{character} corresponding to the data type to be used, must be either 
##' \code{binary}, \code{binary.PA}, \code{abundance}, \code{compositional}
##' @param pkg a \code{character} corresponding to the package containing 
##' the model function to be called
##' @param fun a \code{character} corresponding to the model function name 
##' to be called
##' 
##' @slot model a \code{character} corresponding to the model
##' @slot type a \code{character} corresponding to the data type 
##' (\code{binary}, \code{binary.PA}, \code{abundance}, \code{compositional})
##' @slot package a \code{character} corresponding to the package containing 
##' the model function to be called
##' @slot func a \code{character} corresponding to the model function name 
##' to be called
##' @slot args.names a \code{vector} containing \code{character} corresponding 
##' to the model function arguments
##' @slot args.default a \code{list} containing for each dataset the default 
##' values for all arguments listed in \code{args.names}
##' 
##' 
##' @seealso \code{\link{BIOMOD.options.dataset}}, \code{\link{bm_ModelingOptions}}, 
##' \code{\link{bm_Tuning}}, \code{\link{BIOMOD_Modeling}}, \code{\link{bm_RunModelsLoop}}
##' @family Toolbox objects
##' 
##' 
##' @examples
##' 
##' showClass("BIOMOD.options.default")
##' 
##' 
##' @importFrom utils lsf.str
##' @importFrom methods formalArgs
##' 
##' 
NULL

##' @name BIOMOD.options.default-class
##' @rdname BIOMOD.options.default
##' @export
##' 

# 1.1 Class Definition ----------------------------------------------------------------------------
setClass("BIOMOD.options.default",
         representation(model = 'character',
                        type = 'character',
                        package = "character",
                        func = "character",
                        args.names = "character",
                        args.default = "list"),
         validity = function(object){ return(TRUE) })


# 1.2 Constructors --------------------------------------------------------------------------------
setGeneric("BIOMOD.options.default", def = function(mod, typ, pkg, fun) { standardGeneric("BIOMOD.options.default") })

.BIOMOD.options.default.check.args <- function(mod, typ, pkg, fun)
{
  ## check if model is supported
  avail.models.list <- c('ANN', 'CTA', 'DNN', 'FDA', 'GAM', 'GBM', 'GLM', 'MARS', 'MAXENT', 'MAXNET', 'RF','RFd', 'SRE', 'XGBOOST')
  .fun_testIfIn(TRUE, "mod", mod, avail.models.list)
  
  ## check if type is supported
  avail.types.list <- c('binary', 'abundance', 'count', 'multiclass', 'ordinal', 'relative')
  .fun_testIfIn(TRUE, "typ", typ, avail.types.list)
  
  if (mod != 'MAXENT') {
    ## check package exists
    # lsf.str can be used only with attached package so we are
    # forced to load the packages used in the modeling with attachNamespace
    # attachNamespace(pkg) ==> ERROR : l'espace de noms est déjà attaché
    eval(parse(text = paste0("require(", pkg, ")")))
    
    ## check function exists
    avail.functions.list <- lsf.str(pos = paste0("package:", pkg))
    .fun_testIfIn(TRUE, "fun", fun, avail.functions.list)
  } else {
    if (!file.exists(file.path(getwd(), "maxent.jar"))) {
      warning(paste0("'maxent.jar' file is missing in current working directory ("
                     , getwd(), ").\n"
                     , "It must be downloaded (https://biodiversityinformatics.amnh.org/open_source/maxent/) "
                     , "and put in the working directory."))
    }
  }
}


## BIOMOD.options.default -----------------------------------------------------
##' 
##' @rdname BIOMOD.options.default
##' @export
##' 

setMethod('BIOMOD.options.default', signature(mod = 'character', typ = 'character'),
          function(mod, typ, pkg, fun) 
          {
            .BIOMOD.options.default.check.args(mod, typ, pkg, fun)
            if (mod != 'MAXENT') {
              BOM <- new(
                'BIOMOD.options.default',
                model = mod,
                type = typ,
                package = pkg,
                func = fun,
                args.names = eval(parse(text = paste0("formalArgs(", pkg, "::", fun, ")"))),
                args.default = eval(parse(text = paste0("as.list(formals(", pkg, "::", fun, "))")))
              )
            } else {
              params.MAXENT = list(path_to_maxent.jar = getwd(),
                                   memory_allocated = 512,
                                   initial_heap_size = NULL,
                                   max_heap_size = NULL,
                                   background_data_dir = 'default',
                                   ## since forever :
                                   visible = FALSE,
                                   linear = TRUE,
                                   quadratic = TRUE,
                                   product = TRUE,
                                   threshold = TRUE,
                                   hinge = TRUE,
                                   lq2lqptthreshold = 80,
                                   l2lqthreshold = 10,
                                   hingethreshold = 15,
                                   beta_threshold = -1.0,
                                   beta_categorical = -1.0,
                                   beta_lqp = -1.0,
                                   beta_hinge = -1.0,
                                   betamultiplier = 1,
                                   defaultprevalence = 0.5,
                                   ## newly added :
                                   togglelayerselected = NULL,
                                   maximumbackground = 10000,
                                   maximumiterations = 500,
                                   convergencethreshold = 0.00005,
                                   autofeature = TRUE,
                                   jackknife = FALSE,
                                   writeclampgrid = FALSE,
                                   writemess = FALSE,
                                   logfile = 'maxent.log',
                                   verbose = FALSE)
              
              BOM <- new(
                'BIOMOD.options.default',
                model = mod,
                type = typ,
                package = pkg,
                func = fun,
                args.names = names(params.MAXENT),
                args.default = params.MAXENT
              )
            }
            return(BOM)
          }
)

### default options according to data.type ------------------------------------
##' 
##' @importFrom stats binomial gaussian poisson quasibinomial
##' 

.BIOMOD.options.default.correct <- function(mod, typ, pkg, argstmp)
{
  ## Define type / method / family / distribution according to data.type
  if (typ == "binary") {
    RFtype <- "classification"
    MODfamily <- binomial(link = 'logit')
    CTAmethod <- "class"
    GBMdistribution <- "bernoulli"
    FDAmethod <- "mars"
    XGBOOSTobjective <- "binary:logistic"
    DNNloss <- "binomial"
  } else if(typ == "count") {
    RFtype <- "regression"
    MODfamily <- poisson(link = "log")
    CTAmethod <- "poisson"
    GBMdistribution <- "poisson"
    FDAmethod <- NULL
    XGBOOSTobjective <- "count:poisson"
    DNNloss <- "mse"
  } else if (typ == "multiclass") {
    RFtype <- "classification"
    MODfamily <- quasibinomial() #for MARS
    CTAmethod <- "class"
    GBMdistribution <- "multinomial"
    FDAmethod <- "mars"
    XGBOOSTobjective <- NULL
    DNNloss <- "softmax"
  } else if (typ == "ordinal") {
    RFtype <- "classification"
    MODfamily <- quasibinomial() 
    CTAmethod <- "class"
    GBMdistribution <- "multinomial"
    FDAmethod <- "mars"
    XGBOOSTobjective <- NULL
    DNNloss <- "softmax"
  } else if (typ == "relative") {
    RFtype <- "regression"
    MODfamily <- quasibinomial(link = 'logit')
    #GAMfamily <- betar(link="logit")
    CTAmethod <- "poisson"
    GBMdistribution <- "gaussian"
    FDAmethod <- NULL
    XGBOOSTobjective <- "reg:squarederror"
    DNNloss <- "mse"
  } else { # data.type = nonbinary or data.type = abundance
    RFtype <- "regression"
    MODfamily <- gaussian(link = 'identity')
    CTAmethod <- "poisson" #??
    GBMdistribution <- "gaussian"
    FDAmethod <- NULL
    XGBOOSTobjective <- "reg:squarederror"
    DNNloss <- "mse"
  }
  
  ## Correct default options
  if (mod == "ANN") { 
    argstmp[["x"]] = NULL
    argstmp$size = 2
  }
  if (mod == "CTA") { argstmp$method <- CTAmethod }
  if (mod == "DNN") { 
    argstmp$loss = DNNloss
    argstmp$plot = FALSE
    argstmp$verbose = FALSE
  }
  if (mod == "FDA") {
    argstmp$dimension = NULL
    argstmp$keep.fitted = NULL
    argstmp$method = FDAmethod
  }
  if (mod == "GAM") {
    argstmp[["x"]] = NULL
    argstmp[["y"]] = NULL
    argstmp$family = MODfamily
    if (pkg == "gam") { argstmp$control = gam::gam.control() }
    if (pkg == "mgcv") {
      argstmp$method = "GCV.Cp"
      argstmp$control = mgcv::gam.control()
    }
  }
  if (mod == "GBM"){
    argstmp$distribution = GBMdistribution
  }
  if (mod == "GLM") {
    argstmp$family = MODfamily
    argstmp$control = list()
  }
  if (mod == "MAXNET") { argstmp[["f"]] = NULL }
  if (mod == "MARS") { argstmp$glm = list(family = MODfamily)}
  if (mod == "RF" || mod == "RFd") {
    argstmp[["x"]] = NULL
    argstmp$mtry = 1
    argstmp$type <- RFtype
  }
  if (mod == "XGBOOST") { 
    argstmp$nrounds = 4
    argstmp$verbose = 0
    argstmp$objective = XGBOOSTobjective
  }
  
  argstmp[["..."]] = NULL
  return(argstmp)
}




## --------------------------------------------------------------------------- #
## 2. BIOMOD.options.dataset -------------------------------------------------
## --------------------------------------------------------------------------- #

##' @name BIOMOD.options.dataset
##' @aliases BIOMOD.options.dataset-class
##' @author Maya Guéguen
##' 
##' @title \code{\link{bm_ModelingOptions}} output object class
##' 
##' @description Class returned by \code{\link{bm_ModelingOptions}} (a 
##' \code{list} of \code{BIOMOD.options.dataset} more exactly), and used by 
##' \code{\link{BIOMOD_Modeling}}
##' 
##' 
##' @inheritParams BIOMOD.options.default
##' @param strategy a \code{character} corresponding to the method to 
##' select models' parameters values, must be either \code{default}, 
##' \code{bigboss}, \code{user.defined}, \code{tuned}
##' @param user.val (\emph{optional, default} \code{NULL}) \cr
##' A \code{list} containing parameters values
##' @param user.base (\emph{optional, default} \code{NULL}) \cr A character, 
##' \code{default} or \code{bigboss} used when \code{strategy = 'user.defined'}. 
##' It sets the bases of parameters to be modified by user defined values.
##' @param tuning.fun (\emph{optional, default} \code{NULL}) \cr
##' A \code{character} corresponding to the model function name 
##' to be called through \code{\link[caret]{train}} function for tuning parameters
##' @param bm.format (\emph{optional, default} \code{NULL}) \cr
##' A \code{\link{BIOMOD.formated.data}} or \code{\link{BIOMOD.formated.data.PA}} 
##' object returned by the \code{\link{BIOMOD_FormatingData}} function
##' @param calib.lines (\emph{optional, default} \code{NULL}) \cr
##' A \code{data.frame} object returned by \code{\link{get_calib_lines}} or 
##' \code{\link{bm_CrossValidation}} functions, to explore the distribution of calibration 
##' and validation datasets
##' 
##' @param object a \code{\link{BIOMOD.options.dataset}} object
##' @param x a \code{\link{BIOMOD.options.dataset}} object
##' @param dataset a \code{character} corresponding to the name of a dataset contained 
##' in the \code{arg.values} slot
##' 
##' @slot model a \code{character} corresponding to the model
##' @slot type a \code{character} corresponding to the data type 
##' (\code{binary}, \code{binary.PA}, \code{abundance}, \code{compositional})
##' @slot package a \code{character} corresponding to the package containing 
##' the model function to be called
##' @slot func a \code{character} corresponding to the model function name 
##' to be called
##' @slot args.names a \code{vector} containing \code{character} corresponding 
##' to the model function arguments
##' @slot args.default a \code{list} containing for each dataset the default 
##' values for all arguments listed in \code{args.names}
##' @slot args.values a \code{list} containing for each dataset the to-be-used  
##' values for all arguments listed in \code{args.names}
##' 
##' 
##' @seealso \code{\link{BIOMOD.options.default}}, \code{\link{bm_ModelingOptions}}, 
##' \code{\link{bm_Tuning}}, \code{\link{BIOMOD_Modeling}}, \code{\link{bm_RunModelsLoop}}
##' @family Toolbox objects
##' 
##' 
##' @examples
##' 
##' showClass("BIOMOD.options.dataset")
##' 
##' 
##' @importFrom stats rnorm runif na.omit na.exclude
##' 
NULL

##' @name BIOMOD.options.dataset-class
##' @rdname BIOMOD.options.dataset
##' @export
##' 

# 2.1 Class Definition ----------------------------------------------------------------------------
setClass("BIOMOD.options.dataset",
         contains = "BIOMOD.options.default",
         representation(args.values = "list"),
         validity = function(object){ return(TRUE) })


# 2.2 Constructors --------------------------------------------------------------------------------
setGeneric("BIOMOD.options.dataset",
           def = function(strategy, user.val = NULL, user.base = NULL, 
                          tuning.fun = NULL, bm.format = NULL, calib.lines = NULL, ...) {
             standardGeneric("BIOMOD.options.dataset")
           })

.BIOMOD.options.dataset.check.args <- function(strategy, user.val = NULL, user.base = NULL, tuning.fun = NULL, bm.format = NULL, calib.lines = NULL)
{
  ## check if strategy is supported
  avail.strategy.list <- c('default', 'bigboss', 'user.defined', 'tuned')
  .fun_testIfIn(TRUE, "strategy", strategy, avail.strategy.list)
  
  ## USER DEFINED parameterisation --------------
  if (strategy == "user.defined") {
    avail.user.base <- c('default', 'bigboss')
    .fun_testIfIn(TRUE, "user.base", user.base, avail.user.base)
    
    if (!is.null(user.val)) {
      .fun_testIfInherits(TRUE, "user.val", user.val, c("list"))
    } else if (user.base == "bigboss") {
      strategy <- "bigboss" # revert to bigboss options 
    } else {
      strategy <- "default" # revert to default options
    }
  }
  
  ## TUNING parameterisation --------------------
  if (strategy == "tuned") {
    all.fun <- c('avNNet', 'rpart', 'rpart2', 'tune', 'fda', 'gamSpline', 'bam', 'gam', 'gbm', 'glm', 'earth', 'rf', 'xgbTree')
    .fun_testIfIn(TRUE, "tuning.fun", tuning.fun, c(all.fun, "bm_SRE", "ENMevaluate", "maxnet"))
    .fun_testIfInherits(TRUE, "bm.format", bm.format, c("BIOMOD.formated.data", "BIOMOD.formated.data.PA"))
  }
  
  ## check bm.format, bm.format@PA.table and calib.lines
  if (!is.null(bm.format)) {
    .fun_testIfInherits(TRUE, "bm.format", bm.format, c("BIOMOD.formated.data", "BIOMOD.formated.data.PA"))
  }
  expected_CVnames <- c("_allData_allRun")
  if (!is.null(calib.lines)) {
    .fun_testIfInherits(TRUE, "calib.lines", calib.lines, c("matrix"))
    
    expected_CVnames <- c(paste0("_allData_RUN", seq_len(ncol(calib.lines))), expected_CVnames)
    if (!is.null(bm.format) && inherits(bm.format, "BIOMOD.formated.data.PA")) {
      expected_CVnames <- c(expected_CVnames
                            , sapply(1:ncol(bm.format@PA.table)
                                     , function(this_PA) c(paste0("_PA", this_PA, "_RUN", seq_len(ncol(calib.lines)))
                                                           , paste0("_PA", this_PA, "_allRun"))))
    } 
    .fun_testIfIn(TRUE, "colnames(calib.lines)", colnames(calib.lines), expected_CVnames)
    expected_CVnames <- colnames(calib.lines)
  } else {
    if (!is.null(bm.format) && inherits(bm.format, "BIOMOD.formated.data.PA")) {
      expected_CVnames <- c(expected_CVnames
                            , sapply(1:ncol(bm.format@PA.table)
                                     , function(this_PA) paste0("_PA", this_PA, "_allRun")))
    }
  }
  if (strategy == "user.defined" && !is.null(user.val)) {
    if ("for_all_datasets" %in% names(user.val)){
      if (length(names(user.val)) > 1 ){
        user.val <- user.val["for_all_datasets"]
        cat("\n\t\t> Only the options defined for 'for_all_datasets' will be taken into account")
      }
      user.val <- rep(user.val, length(expected_CVnames))
      names(user.val) <- expected_CVnames
    }
    
    .fun_testIfIn(TRUE, "names(user.val)", names(user.val), c(expected_CVnames, "for_all_datasets"))
    
    if (length(names(user.val)) != length(expected_CVnames)) {
      warning(paste0("Options will be changed only for a subset of datasets ("
                     , paste0(names(user.val), collapse = ", ")
                     , ") and not the others ("
                     , paste0(setdiff(expected_CVnames, names(user.val)), collapse = ", ")
                     , "). \nPlease update 'user.val' argument if this is not wanted."))
    }
  }
  
  return(list(strategy = strategy,
              expected_CVnames = expected_CVnames,
              user.val = user.val))
}

# .BIOMOD.options.dataset.test <- function(bm.opt)
# {
#   ## create false dataset
#   mySp = "Hariba"
#   myResp = c(rep(1, 100), rep(0, 100))
#   myRespXY = data.frame(x = sample(1:100, 200, replace = TRUE)
#                         , y = sample(1:100, 200, replace = TRUE))
#   myExpl = data.frame(var1 = rnorm(200, mean = 3, sd = 0.4)
#                       , var2 = runif(200)
#                       , var3 = sample(1:5, 200, replace = TRUE))
#   mySpExpl = cbind(myResp, myExpl)
#   colnames(mySpExpl)[1] = mySp
#   
#   ## get options for specific model
#   if (bm.opt@model == "GAM") {
#     subclass_name <- paste0(bm.opt@model, "_", bm.opt@type, "_", bm.opt@package)
#     .load_gam_namespace(model_subclass = subclass_name)
#   }
#   
#   ## 
#   for (xx in 1:length(bm.opt@args.values)) { ## SHOULD BE MOVED to place when testing values ??
#     if ('...' %in% names(bm.opt@args.values[[xx]])) {
#       bm.opt@args.values[[xx]][['...']] <- NULL
#     }
#   }
#   print(bm.opt)
#   
#   ## run test for each dataset
#   for (dataset_name in names(bm.opt@args.values)) {
#     bm.opt.val <- bm.opt@args.values[[dataset_name]]
#     
#     ## 2. CREATE MODELS -----------------------------------------------------------------------------
#     set.seed(42)
#     
#     if (bm.opt@model != "MAXENT") { ## ANY MODEL BUT MAXENT ------------------------------------------------
#       ## PRELIMINAR ---------------------------------------------------
#       bm.opt.val$formula <- bm_MakeFormula(resp.name = mySp
#                                            , expl.var = head(myExpl)
#                                            , type = 'simple'
#                                            , interaction.level = 0)
#       
#       if (bm.opt@model == "RF" && !is.null(bm.opt.val$type) && bm.opt.val$type == 'classification') {
#         # defining occurences as factor for doing classification and not regression in RF
#         mySpExpl <- mySpExpl %>% mutate_at(mySp, factor)
#       }
#       
#       ## FILL data parameter ------------------------------------------
#       if (bm.opt@model %in% c("ANN", "CTA", "FDA", "GAM", "GBM", "MARS", "RF", "GLM")) {
#         bm.opt.val$data <- mySpExpl
#       } else if (bm.opt@model == "MAXNET") {
#         bm.opt.val$p <- myResp
#         bm.opt.val$data <- myExpl
#       } else if (bm.opt@model == "SRE") {
#         bm.opt.val$resp.var <- myResp
#         bm.opt.val$expl.var <- myExpl
#       } else if (bm.opt@model == "XGBOOST") {
#         bm.opt.val$label <- myResp
#         bm.opt.val$data <- as.matrix(myExpl)
#       }
#       
#       ## RUN model ----------------------------------------------------
#       print("you")
#       model.sp <- do.call(bm.opt@func, bm.opt.val)
#       print("pi")
#     } else {
#       ## STUFF MAXENT
#     }
#   }
# }


## BIOMOD.options.dataset -----------------------------------------------------
##' 
##' @rdname BIOMOD.options.dataset
##' @export
##' 

setMethod('BIOMOD.options.dataset', signature(strategy = 'character'),
          function(mod, typ, pkg, fun, strategy
                   , user.val = NULL, user.base = NULL
                   , tuning.fun = NULL
                   , bm.format = NULL, calib.lines = NULL)
          {
            cat('\n\t> ', mod, 'options ( datatype:', typ, ', package:', pkg, ', function:', fun, ')...')
            
            args <- .BIOMOD.options.dataset.check.args(strategy = strategy, user.val = user.val
                                                       , user.base = user.base, tuning.fun = tuning.fun
                                                       , bm.format = bm.format, calib.lines = calib.lines)
            for (argi in names(args)) { assign(x = argi, value = args[[argi]]) }
            rm(args)
            
            ## GET default values and correct according to data.type --------------------
            BOM <- BIOMOD.options.default(mod, typ, pkg, fun)
            
            argstmp <- BOM@args.default
            argstmp <- .BIOMOD.options.default.correct(mod, typ, pkg, argstmp)
            
            BOM@args.default <- argstmp
            
            ## SPECIFIC case of formula -------------------------------------------------
            if ("formula" %in% BOM@args.names) {
              if (!is.null(bm.format)) {
                if (is.null(argstmp$formula) || 
                    (length(argstmp$formula) == 1 && nchar(argstmp$formula) == 0) ||
                    argstmp$formula == "formula(data)") {
                  argstmp$formula <- bm_MakeFormula(resp.name = bm.format@sp.name
                                                    , expl.var = head(bm.format@data.env.var)
                                                    , type = ifelse(mod == "GAM" && pkg == "mgcv", 's_smoother'
                                                                    , ifelse(mod == "GLM", 'quadratic'
                                                                             , 'simple'))
                                                    , interaction.level = 0)
                }
              } else {
                warning("No bm.format provided. No definition of formula through bm_MakeFormula.")
              }
            }
            
            ## GET parameter values according to strategy -------------------------------
            if (strategy %in% c("default", "bigboss") || (strategy == "user.defined" && user.base == "bigboss")) {
              if (strategy == "bigboss" || (strategy == "user.defined" && user.base == "bigboss")) {
                # data(OptionsBigboss) # internal data is readily available
                # typ.bigboss <- ifelse(typ == "binary", "binary", "nonbinary")
                
                val <- OptionsBigboss@options[[paste0(c(mod, pkg, fun), collapse = ".")]]@args.values[['_allData_allRun']]
                for (ii in names(val)) {
                  if (ii != "formula") { argstmp[[ii]] <- val[[ii]] }
                }
              }
              
              argsval <- lapply(expected_CVnames, function(xx) { argstmp })
              names(argsval) <- expected_CVnames
            }
            
            if (strategy == "user.defined") {
              if (!("..." %in% BOM@args.names)) {
                for (CVname in names(user.val)) {
                  .fun_testIfIn(TRUE, paste0("names(user.val[['", CVname, "']])"), names(user.val[[CVname]]), BOM@args.names)
                }
              } else {
                ## ???
              }
              
              argsval <- lapply(expected_CVnames, function(xx) { argstmp })
              names(argsval) <- expected_CVnames
              
              for (CVname in names(user.val)) {
                val <- user.val[[CVname]]
                for (ii in names(val)) { 
                  argsval[[CVname]][[ii]] <- val[[ii]] 
                }
              }
              
            } else if (strategy == "tuned") {
              
              if(typ == "binary"){
                metric <- ifelse(mod == "MAXENT", "auc.val.avg", "TSS")
              } else if (typ %in% c("multiclass", "ordinal")) {
                metric <- "Accuracy"
              } else {metric <- "Rsquared"}
              
              
              argsval <- bm_Tuning(model = mod, tuning.fun = tuning.fun, do.formula = TRUE, do.stepAIC = TRUE
                                   , bm.options = BOM, bm.format = bm.format, calib.lines = calib.lines
                                   , metric.eval = metric)
              
              # To avoid problem with ENMeval and "bad closing" of foreach loop
              env <- foreach:::.foreachGlobals
              rm(list = ls(name = env), pos = env)
            }
            BOD <- new('BIOMOD.options.dataset', BOM, args.values = argsval)
            
            ## TEST that all given options do not produce errors ------------------------
            # .BIOMOD.options.dataset.test(bm.opt = BOD)
            
            return(BOD)
          }
)


# 2.3 Other Functions -----------------------------------------------------------------------------

### show BIOMOD.options.dataset -----------------------------------------------
##'
##' @rdname BIOMOD.options.dataset
##' @importMethodsFrom methods show
##' @export
##'


## Attention ! print only values for _allData_allRun
setMethod('show', signature('BIOMOD.options.dataset'),
          function(object)
          {
            cat('\n\t> ', object@model, 'options ( datatype:', object@type, ', package:', object@package, ', function:', object@func, ') :')
            # for (arg in object@args.names) { ## NOT working for bigboss for example, if new parameters
            dataset <- ifelse("_allData_allRun" %in% names(object@args.values)
                              , "_allData_allRun", names(object@args.values)[1])
            cat('\n\t   ( dataset', dataset, ')')
            
            for (arg in names(object@args.values[[dataset]])) {
              val.def = capture.output(object@args.default[[arg]])
              val.used = capture.output(object@args.values[[dataset]][[arg]])
              if (arg == 'data') val.used = head(val.used)
              
              cat('\n\t\t- ', arg, "=", sub("\\[1\\] ", "", val.used))
              if (!is.null(val.used) && !is.null(val.def) &&
                  (length(val.used) != length(val.def) || any(val.used != val.def))) {
                cat('   (default:', sub("\\[1\\] ", "", val.def), ')')
              }
            }
            cat("\n")
          }
)

##'
##' @rdname BIOMOD.options.dataset
##' @export
##'

setMethod('print', signature('BIOMOD.options.dataset'),
          function(x, dataset = '_allData_allRun')
          {
            object = x
            cat('\n\t> ', object@model, 'options ( datatype:', object@type, ', package:', object@package, ', function:', object@func, ') :')
            dataset <- ifelse(dataset %in% names(object@args.values)
                              , dataset, ifelse("_allData_allRun" %in% names(object@args.values)
                                                , "_allData_allRun", names(object@args.values)[1]))
            cat('\n\t   ( dataset', dataset, ')')
            
            for (arg in names(object@args.values[[dataset]])) {
              val.def = capture.output(object@args.default[[arg]])
              val.used = capture.output(object@args.values[[dataset]][[arg]])
              
              cat('\n\t\t- ', arg, "=", sub("\\[1\\] ", "", val.used))
              if (!is.null(val.used) && !is.null(val.def) && 
                  (length(val.used) != length(val.def) || any(val.used != val.def))) {
                cat('   (default:', sub("\\[1\\] ", "", val.def), ')')
              }
            }
            cat("\n")
          }
)


## --------------------------------------------------------------------------- #
## 3. BIOMOD.models.options --------------------------------------------------
## --------------------------------------------------------------------------- #

##' @name BIOMOD.models.options
##' @aliases BIOMOD.models.options-class
##' @author Maya Guéguen
##' 
##' @title \code{\link{bm_ModelingOptions}} output object class
##' 
##' @description Class returned by \code{\link{bm_ModelingOptions}} and used by 
##' \code{\link{BIOMOD_Modeling}}
##' 
##' @param object a \code{\link{BIOMOD.models.options}} object
##' @param x a \code{\link{BIOMOD.models.options}} object
##' @param dataset a \code{character} corresponding to the name of a dataset contained 
##' in the \code{arg.values} slot of the \code{\link{BIOMOD.options.dataset}} object 
##' for each model
##' 
##' @slot models a \code{vector} containing model names for which options have 
##' been retrieved and defined, must be \code{algo.datatype.package.function}
##' @slot options a \code{list} containing \code{\link{BIOMOD.options.dataset}} 
##' object for each model
##' 
##' 
##' @seealso \code{\link{BIOMOD.options.default}}, 
##' \code{\link{BIOMOD.options.dataset}}, 
##' \code{\link{bm_ModelingOptions}}, \code{\link{bm_Tuning}}, 
##' \code{\link{BIOMOD_Modeling}}
##' @family Toolbox objects
##' 
##' 
##' @examples
##' 
##' showClass("BIOMOD.models.options")
##' 
##' 
NULL

##' @name BIOMOD.models.options-class
##' @rdname BIOMOD.models.options
##' @export
##' 

# 3.1 Class Definition ----------------------------------------------------------------------------
setClass("BIOMOD.models.options",
         representation(models = "character", options = "list"),
         validity = function(object){ return(TRUE) })

# 3.3 Other Functions -----------------------------------------------------------------------------

### show BIOMOD.models.options ------------------------------------------------
##'
##' @rdname BIOMOD.models.options
##' @importMethodsFrom methods show
##' @export
##'

setMethod('show', signature('BIOMOD.models.options'),
          function(object)
          {
            .bm_cat("BIOMOD.models.options")
            for (mod in object@models) {
              show(object@options[[mod]])
            }
            .bm_cat()
          }
)

##'
##' @rdname BIOMOD.models.options
##' @export
##'

setMethod('print', signature('BIOMOD.models.options'),
          function(x, dataset = '_allData_allRun')
          {
            object = x
            .bm_cat("BIOMOD.models.options")
            for (mod in object@models) {
              print(object@options[[mod]], dataset = dataset)
            }
            .bm_cat()
          }
)