Merge pull request #71 from wevertonbio/main

New functions and vignettes

Author: wevertonbio

DESCRIPTION

@@ -35,6 +35,7 @@ Imports:
     doSNOW, 
     enmpa (>= 0.2.1),
     foreach (>= 1.5),
+    fpROC (>= 0.1.0),
     glmnet (>= 4.1),
     grDevices,
     graphics,

NAMESPACE

@@ -8,6 +8,7 @@ S3method(print,projection_data)
 export(advanced_cleaning)
 export(bivariate_response)
 export(calibration)
+export(colors_for_changes)
 export(detect_concave)
 export(explore_calibration_geo)
 export(explore_calibration_hist)
@@ -19,6 +20,7 @@ export(glmnet_mx)
 export(import_projections)
 export(initial_cleaning)
 export(move_2closest_cell)
+export(organize_for_projection)
 export(organize_future_worldclim)
 export(partial_roc)
 export(perform_pca)
@@ -43,15 +45,16 @@ export(sort_columns)
 export(variable_importance)
 importFrom(doSNOW,registerDoSNOW)
 importFrom(enmpa,aux_var_comb)
-importFrom(enmpa,kfold_partition)
 importFrom(enmpa,predict_glm)
-importFrom(enmpa,proc_enm)
 importFrom(foreach,`%dopar%`)
 importFrom(foreach,foreach)
+importFrom(fpROC,auc_metrics)
 importFrom(glmnet,glmnet)
 importFrom(glmnet,glmnet.control)
 importFrom(grDevices,adjustcolor)
+importFrom(grDevices,col2rgb)
 importFrom(grDevices,hcl.colors)
+importFrom(grDevices,rgb)
 importFrom(graphics,abline)
 importFrom(graphics,arrows)
 importFrom(graphics,axis)
@@ -101,12 +104,14 @@ importFrom(terra,as.data.frame)
 importFrom(terra,buffer)
 importFrom(terra,cells)
 importFrom(terra,clamp)
+importFrom(terra,coltab)
 importFrom(terra,crop)
 importFrom(terra,diff)
 importFrom(terra,distance)
 importFrom(terra,ext)
 importFrom(terra,extract)
 importFrom(terra,levels)
+importFrom(terra,mask)
 importFrom(terra,mean)
 importFrom(terra,median)
 importFrom(terra,minmax)

R/Classes.R

@@ -28,13 +28,18 @@ new_explore_list <- function(summary, exploration_stats,
 
 # prepared_data Class Constructor
 new_prepared_data <- function(species, calibration_data, formula_grid,
-                             kfolds, data_xy, continuous_variables,
+                             part_data, partition_method, n_replicates,
+                             train_proportion, data_xy,
+                             continuous_variables,
                              categorical_variables, weights, pca, algorithm) {
   data <- list(
     species = species,
     calibration_data = calibration_data,
     formula_grid = formula_grid,
-    kfolds = kfolds,
+    part_data = part_data,
+    partition_method = partition_method,
+    n_replicates = n_replicates,
+    train_proportion = train_proportion,
     data_xy = data_xy,
     continuous_variables = continuous_variables,
     categorical_variables = categorical_variables,
@@ -77,7 +82,10 @@ new_fitted_models <- function(species,
                               addsamplestobackground,
                               omission_rate,
                               thresholds,
-                              algorithm){
+                              algorithm,
+                              partition_method,
+                              n_replicates,
+                              train_proportion){
   data <- list(
     species = species,
     Models = Models,
@@ -90,7 +98,10 @@ new_fitted_models <- function(species,
     addsamplestobackground = addsamplestobackground,
     omission_rate = omission_rate,
     thresholds = thresholds,
-    algorithm = algorithm
+    algorithm = algorithm,
+    partition_method = partition_method,
+    n_replicates = n_replicates,
+    train_proportion = train_proportion
   )
   class(data) <- "fitted_models"
   return(data)

R/Methods.R

@@ -99,8 +99,13 @@ print.prepared_data <- function(x, ...) {
   cat("  - Presence:", table(x$calibration_data$pr_bg)[2], "\n")
   cat("  - Background:", table(x$calibration_data$pr_bg)[1], "\n")
 
-  cat("Training-Testing Method:\n")
-  cat("  - k-fold Cross-validation:", length(x$kfolds), "folds\n")
+  cat("Partition Method:", x$partition_method, "\n")
+  if(x$partition_method %in% c("kfolds", "leave-one-out"))
+    cat("  - Number of kfolds:", length(x$part_data), "\n")
+  if(x$partition_method%in% c("subsample", "bootstrap")){
+    cat("  - Number of replicates:", x$n_replicates, "\n")
+    cat("  - Train proportion:", x$train_proportion, "\n")
+  }
 
   cat("Continuous Variables:\n")
   cat("  -", paste(x$continuous_variables, collapse = ", "), "\n")

R/bivariate_response.R

@@ -52,15 +52,15 @@
 #' data(fitted_model_maxnet, package = "kuenm2")
 #'
 #' # Response curve (notice response affected by covariance)
-#' bivariate_response(models = fitted_model_maxnet, modelID = "Model_189",
+#' bivariate_response(models = fitted_model_maxnet, modelID = "Model_219",
 #'                    variable1 = "bio_1", variable2 = "bio_12")
 #'
 #' # Example with glm
 #' # Import example of fitted_models (output of fit_selected())
 #' data(fitted_model_glm, package = "kuenm2")
 #'
 #' # Response curve
-#' bivariate_response(models = fitted_model_glm, modelID = "Model_86",
+#' bivariate_response(models = fitted_model_glm, modelID = "Model_85",
 #'                    variable1 = "bio_1", variable2 = "bio_7")
 
 bivariate_response <- function(models,

R/calibration.R

@@ -74,7 +74,8 @@
 #' @importFrom utils txtProgressBar setTxtProgressBar read.csv head write.csv
 #' @importFrom stats aggregate glm as.formula
 #' @importFrom glmnet glmnet.control glmnet
-#' @importFrom enmpa proc_enm
+#' @importFrom enmpa predict_glm
+#' @importFrom fpROC auc_metrics
 #'
 #' @export
 #'
@@ -129,23 +130,39 @@
 #' Warren and Seifert (2011).
 #'
 #' @examples
-#' # Import prepared data for maxnet models
-#' data(sp_swd, package = "kuenm2")
+#' # Import occurrences
+#' data(occ_data, package = "kuenm2")
 #'
+#' # Import raster layers
+#' var <- terra::rast(system.file("extdata", "Current_variables.tif",
+#'                                package = "kuenm2"))
+#' # Use only continuous variables
+#' var <- var[[c("bio_1", "bio_7", "bio_12", "bio_15")]]
+#'
+#' # Prepare data for maxnet model
+#' sp_swd <- prepare_data(algorithm = "maxnet", occ = occ_data,
+#'                        x = "x", y = "y",
+#'                        raster_variables = var,
+#'                        species = occ_data[1, 1],
+#'                        n_background = 100, ,
+#'                        features = c("l", "lq"),
+#'                        r_multiplier = 1,
+#'                        partition_method = "kfolds")
 #' # Model calibration (maxnet)
 #' m <- calibration(data = sp_swd, error_considered = 10)
-#'
 #' m
 #'
-#' # Import prepared data for GLM models
-#' data(sp_swd_glm, package = "kuenm2")
-#'
-#' ## Model calibration (GLM)
+#' # Prepare data for glm model
+#' sp_swd_glm <- prepare_data(algorithm = "glm", occ = occ_data,
+#'                            x = "x", y = "y",
+#'                            raster_variables = var,
+#'                            species = occ_data[1, 1],
+#'                            n_background = 100,
+#'                            features = c("l", "lq"),
+#'                            partition_method = "kfolds")
 #' m_glm <- calibration(data = sp_swd_glm, error_considered = 10)
-#'
 #' m_glm
 
-
 calibration <- function(data,
                         error_considered,
                         remove_concave = FALSE,
@@ -260,7 +277,15 @@ calibration <- function(data,
       message("Task 1/2: checking for concave responses in models:")
     }
 
-    q_grids <- formula_grid[grepl("q", formula_grid$Features), ]
+    #Get maximum reg multipliers (if algorithm is maxnet)
+    if(algorithm == "maxnet"){
+    max_reg <- max(formula_grid$R_multiplier)
+    q_grids <- formula_grid[grepl("q", formula_grid$Features) &
+                              formula_grid$R_multiplier == max_reg, ]
+    } else {
+      q_grids <- formula_grid[grepl("q", formula_grid$Features), ]
+    }
+    #Get total number of models to test
     n_tot <- nrow(q_grids)
 
     if (n_tot == 0) {