Fix Options + do.full.models

Modif in bm_crossvalidation to accept an user table made with do.full.models = T Modif in Biomod_modeling to accept options made only on PA datasets (and not PA+run datasets)
biomodhub · May 2, 2024 · 85c78a5 · 85c78a5
1 parent 55c9350
commit 85c78a5
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 7 deletions.
diff --git a/R/BIOMOD_Modeling.R b/R/BIOMOD_Modeling.R
@@ -471,6 +471,16 @@ BIOMOD_Modeling <- function(bm.format,
           for (ii in vals) {
             OPT.user@options[[mod]]@args.values[[ii]] <- val
           }
+        } else if (all(grepl("_allRun", nam))){ #Check if the user create the options just for PA dataset
+          model.name <- unlist(strsplit(mod,split = '[.]'))[1]
+          cat("\n \t The options for",model.name, "for '_PAx_allRun' will be given to all runs with PAx (_PAx_RUN1, _PAx_RUN2,...) \n")
+          for (run in vals){
+            PA.set <- grep("PA", unlist(strsplit(run, "_")), value = T)
+            if (length(PA.set) == 0){
+              PA.set <- "allData"
+            }
+            OPT.user@options[[mod]]@args.values[[run]] <- OPT.user@options[[mod]]@args.values[[paste0("_", PA.set, "_allRun")]]
+          }
         } else {
           stop(paste0("\n", "names(OPT.user@options[['", mod, "']]@args.values)", " must be '",
                       ifelse(length(vals) > 1,
@@ -662,7 +672,7 @@ BIOMOD_Modeling <- function(bm.format,
   #   bm.options <- BIOMOD_ModelingOptions()
   # }
 
-  ## 4. Check user 
+  ## 4. Check CV.user.table
   if (!is.null(CV.user.table)){
     if(!("_allData_allRun" %in% colnames(CV.user.table)) & CV.do.full.models == T){ 
       CV.do.full.models = FALSE

diff --git a/R/bm_CrossValidation.R b/R/bm_CrossValidation.R
@@ -485,16 +485,20 @@ setMethod('bm_CrossValidation_user.defined', signature(bm.format = "BIOMOD.forma
 setMethod('bm_CrossValidation_user.defined', signature(bm.format = "BIOMOD.formated.data.PA"),
           function(bm.format, user.table) {
             cat("\n   > User defined cross-validation selection")
-            .check_calib.lines_names(user.table, 
-                                     expected_PA.names = colnames(bm.format@PA.table))
+            nb_PA <- ncol(bm.format@PA.table)
+            names_to_remove <- c("_allData_allRun", paste0("_PA", 1:nb_PA, "_allRun")) #We suppose that if they are in the format it should be fine
+            table_to_test <- user.table[,!(colnames(user.table) %in% names_to_remove)]
 
+            expected_PA.names <- colnames(bm.format@PA.table)
+            .check_calib.lines_names(table_to_test, expected_PA.names = expected_PA.names)
+
+            PA.table <- cbind(bm.format@PA.table, "allData" = TRUE) #just to pass the check
             calib.lines <-
-              foreach(this.colnames = colnames(user.table),
-                      .combine = "cbind") %do% {
+              foreach(this.colnames = colnames(user.table), .combine = "cbind") %do% {
                         this.pa = strsplit(this.colnames, split = "_")[[1]][2]
                         calib.pa <- user.table[,this.colnames, drop = FALSE]
-                        which.not.pa <- which(bm.format@PA.table[, this.pa] == FALSE |
-                                                is.na(bm.format@PA.table[, this.pa]))
+                        which.not.pa <- which(PA.table[, this.pa] == FALSE |
+                                                is.na(PA.table[, this.pa]))
                         if(length(which.not.pa) > 0){
                           calib.pa[which.not.pa, ] <- NA
                         }