From 85c78a5d6498db22b956aeabb5c96ebea984abc2 Mon Sep 17 00:00:00 2001 From: HeleneBlt Date: Thu, 2 May 2024 09:43:31 +0200 Subject: [PATCH] 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) --- R/BIOMOD_Modeling.R | 12 +++++++++++- R/bm_CrossValidation.R | 16 ++++++++++------ 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/R/BIOMOD_Modeling.R b/R/BIOMOD_Modeling.R index cc530cd2..dfde419c 100644 --- 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 index ce15c9ff..32c77b41 100644 --- 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 }