From e277dd8120fdd4236066dd7fccbb42d6a33acecf Mon Sep 17 00:00:00 2001 From: Daniel Lopez Date: Tue, 16 Dec 2025 13:13:41 -0500 Subject: [PATCH 1/2] Fix: Enable running models with categorical variables when using ENMeval >2.0.5 --- R/model_bioclim.R | 8 ++-- R/model_maxent.R | 14 ++++-- R/penvs_bgMask.R | 18 +++---- R/penvs_bgSample.R | 2 +- R/vis_bioclimPlot.R | 2 +- R/xfer_area.R | 2 +- R/xfer_time.R | 2 +- R/xfer_userEnvs.R | 2 +- inst/shiny/modules/part_spat.Rmd | 2 +- inst/shiny/modules/penvs_bgExtent.R | 9 ++-- inst/shiny/modules/penvs_bgExtent.Rmd | 4 +- inst/shiny/modules/penvs_drawBgExtent.R | 9 ++-- inst/shiny/modules/penvs_drawBgExtent.Rmd | 4 +- inst/shiny/modules/penvs_userBgExtent.R | 9 ++-- inst/shiny/modules/penvs_userBgExtent.Rmd | 4 +- inst/shiny/modules/vis_mapPreds.R | 12 ++--- inst/shiny/modules/vis_mapPreds.Rmd | 12 ++--- inst/shiny/modules/xfer_mess.R | 4 +- inst/shiny/modules/xfer_mess.Rmd | 2 +- inst/shiny/modules/xfer_time.Rmd | 58 ++++++++++++++--------- inst/shiny/server.R | 8 ++-- tests/testthat/test_model_bioclim.R | 2 +- tests/testthat/test_model_maxent.R | 4 +- tests/testthat/test_penvs_bgMask.R | 18 +++---- tests/testthat/test_penvs_bgSample.R | 7 +-- tests/testthat/test_vis_bioclimPlot.R | 2 +- tests/testthat/test_xfer_area.R | 2 +- tests/testthat/test_xfer_time.R | 2 +- tests/testthat/test_xfer_userEnvs.R | 2 +- 29 files changed, 125 insertions(+), 101 deletions(-) diff --git a/R/model_bioclim.R b/R/model_bioclim.R index 855830849..2411ec2c4 100644 --- a/R/model_bioclim.R +++ b/R/model_bioclim.R @@ -35,8 +35,8 @@ #' @param bg coordinates of background points to be used for modeling. #' @param user.grp a list of two vectors containing group assignments for #' occurrences (occs.grp) and background points (bg.grp). -#' @param bgMsk a RasterStack or a RasterBrick of environmental layers cropped -#' and masked to match the provided background extent. +#' @param bgMsk a SpatRaster of environmental layers cropped and masked to +#' match the provided background extent. #' @param logger Stores all notification messages to be displayed in the Log #' Window of Wallace GUI. Insert the logger reactive list here for running #' in shiny, otherwise leave the default NULL. @@ -55,7 +55,7 @@ #' bg <- read.csv(system.file("extdata/Bassaricyon_alleni_bgPoints.csv", #' package = "wallace")) #' partblock <- part_partitionOccs(occs, bg, method = 'block') -#' m <- model_bioclim(occs, bg, partblock, envs) +#' m <- model_bioclim(occs, bg, partblock, terra::rast(envs)) #' } #' #' @return Function returns an ENMevaluate object with all the evaluated models @@ -80,7 +80,7 @@ model_bioclim <- function(occs, bg, user.grp, bgMsk, logger = NULL, smartProgress(logger, message = paste0("Building/Evaluating BIOCLIM model for ", spName(spN), "..."), { - e <- ENMeval::ENMevaluate(occs = occs.xy, envs = terra::rast(bgMsk), bg = bg.xy, + e <- ENMeval::ENMevaluate(occs = occs.xy, envs = bgMsk, bg = bg.xy, algorithm = "bioclim", partitions = "user", user.grp = user.grp) }) diff --git a/R/model_maxent.R b/R/model_maxent.R index a1365dba6..594dca465 100644 --- a/R/model_maxent.R +++ b/R/model_maxent.R @@ -36,8 +36,8 @@ #' @param bg coordinates of background points to be used for modeling. #' @param user.grp a list of two vectors containing group assignments for #' occurrences (occs.grp) and background points (bg.grp). -#' @param bgMsk a RasterStack or a RasterBrick of environmental layers cropped -#' and masked to match the provided background extent. +#' @param bgMsk a SpatRaster of environmental layers cropped and masked to +#' match the provided background extent. #' @param rms vector of range of regularization multipliers to be used in the #' ENMeval run. #' @param rmsStep step to be used when defining regularization multipliers to @@ -76,7 +76,7 @@ #' rmsStep <- 1 #' fcs <- c('L', 'LQ') #' m <- model_maxent(occs = occs, bg = bg, user.grp = partblock, -#' bgMsk = envs, rms = rms, rmsStep, fcs, +#' bgMsk = terra::rast(envs), rms = rms, rmsStep, fcs, #' clampSel = TRUE, algMaxent = "maxnet", #' parallel = FALSE) #' } @@ -192,12 +192,18 @@ model_maxent <- function(occs, bg, user.grp, bgMsk, rms, rmsStep, fcs, # get just coordinates occs.xy <- occs %>% dplyr::select("longitude", "latitude") bg.xy <- bg %>% dplyr::select("longitude", "latitude") + + # convert the categorical variables to factors + if (!is.null(catEnvs)) { + bgMsk[[catEnvs]] <- terra::as.factor(bgMsk[[catEnvs]]) + } + # run ENMeval e <- ENMeval::ENMevaluate(occs = as.data.frame(occs.xy), bg = as.data.frame(bg.xy), partitions = 'user', user.grp = user.grp, - envs = terra::rast(bgMsk), + envs = bgMsk, tune.args = tune.args, doClamp = clampSel, algorithm = algMaxent, diff --git a/R/penvs_bgMask.R b/R/penvs_bgMask.R index 7aca1b865..fbd2cfcb3 100644 --- a/R/penvs_bgMask.R +++ b/R/penvs_bgMask.R @@ -31,8 +31,8 @@ #' environmental layers to be used in the modeling are cropped and masked #' to the provided background area. The background area is determined in #' the function penvs_bgExtent from the same component. The function returns -#' the provided environmental layers cropped and masked in the provided -#' format (either a rasterBrick or a rasterStack). +#' the provided environmental layers cropped and masked in the SpatRaster +#' format. #' #' @param occs data frame of cleaned or processed occurrences obtained from #' components occs: Obtain occurrence data or, poccs: Process occurrence data. @@ -59,10 +59,11 @@ #' bgMask <- penvs_bgMask(occs, envs, bgExt) #' } #' -#' @return A RasterStack or a RasterBrick of environmental layers cropped and +#' @return A SpatRaster of environmental layers cropped and #' masked to match the provided background extent. #' @author Jamie Kass #' @author Gonzalo E. Pinilla-Buitrago +#' @author Daniel Lopez-Lozano #' @seealso \code{\link{penvs_userBgExtent}}, #' \code{\link{penvs_drawBgExtent}}, \code{\link{penvs_bgExtent}}, #' \code{\link{penvs_bgSample}} @@ -81,18 +82,17 @@ penvs_bgMask <- function(occs, envs, bgExt, logger = NULL, spN = NULL) { message = paste0("Masking rasters for ", spName(spN), "..."), { - bgCrop <- raster::crop(envs, bgExt) - bgMask <- raster::mask(bgCrop, bgExt) + envs <- terra::rast(envs) + bgCrop <- terra::crop(envs, bgExt) + bgMask <- terra::mask(bgCrop, terra::vect(bgExt)) # GEPB: Workaround when raster alignment is changed after crop, which makes appears # new duplicated occs in the same grid cells. - occsEnvsVals <- as.data.frame(raster::extract(bgMask, + occsEnvsVals <- as.data.frame(terra::extract(bgMask, occs[, c('longitude', 'latitude')], cellnumbers = TRUE)) occs.dups <- duplicated(occsEnvsVals[, 1]) if (sum(occs.dups) > 0) { - bgMask <- terra::project(terra::rast(bgMask), - terra::rast(envs), method = 'near') - bgMask <- methods::as(bgMask, "Raster") + bgMask <- terra::project(bgMask, envs, method = 'near') } }) diff --git a/R/penvs_bgSample.R b/R/penvs_bgSample.R index e16523ac8..709936eb6 100644 --- a/R/penvs_bgSample.R +++ b/R/penvs_bgSample.R @@ -58,7 +58,7 @@ #' doBrick = TRUE) #' bgExt <- penvs_bgExtent(occs, bgSel = 'bounding box', bgBuf = 0.5) #' bgMask <- penvs_bgMask(occs, envs, bgExt) -#' bgsample <- penvs_bgSample(occs, bgMask, bgPtsNum = 1000) +#' bgsample <- penvs_bgSample(occs, raster::stack(bgMask), bgPtsNum = 1000) #' } #' #' @return a dataframe containing point coordinates (longitude and latitude). diff --git a/R/vis_bioclimPlot.R b/R/vis_bioclimPlot.R index d20a9479f..cc0e59bd3 100644 --- a/R/vis_bioclimPlot.R +++ b/R/vis_bioclimPlot.R @@ -56,7 +56,7 @@ #' bg <- read.csv(system.file("extdata/Bassaricyon_alleni_bgPoints.csv", #' package = "wallace")) #' partblock <- part_partitionOccs(occs, bg, method = 'block') -#' m <- model_bioclim(occs, bg, partblock, envs) +#' m <- model_bioclim(occs, bg, partblock, terra::rast(envs)) #' bioclimPlot <- vis_bioclimPlot(x = m@@models$bioclim, #' a = 1, b = 2, p = 1) #' } diff --git a/R/xfer_area.R b/R/xfer_area.R index 4821aa61a..b62ff0676 100644 --- a/R/xfer_area.R +++ b/R/xfer_area.R @@ -77,7 +77,7 @@ #' partblock <- part_partitionOccs(occs, bg, method = 'block') #' m <- model_maxent(occs, bg, #' user.grp = partblock, -#' bgMsk = envs, rms = c(1:2), +#' bgMsk = terra::rast(envs), rms = c(1:2), #' rmsStep = 1, fcs = c('L', 'LQ'), #' clampSel = TRUE, #' algMaxent = "maxnet", diff --git a/R/xfer_time.R b/R/xfer_time.R index d6f69121e..007897254 100644 --- a/R/xfer_time.R +++ b/R/xfer_time.R @@ -78,7 +78,7 @@ #' occs <- read.csv(system.file("extdata/Bassaricyon_alleni.csv",package = "wallace")) #' bg <- read.csv(system.file("extdata/Bassaricyon_alleni_bgPoints.csv", package = "wallace")) #' partblock <- part_partitionOccs(occs, bg, method = 'block') -#' m <- model_maxent(occs, bg, user.grp = partblock, bgMsk = envs, rms = c(1:2), +#' m <- model_maxent(occs, bg, user.grp = partblock, bgMsk = terra::rast(envs), rms = c(1:2), #' rmsStep = 1, fcs = c('L', 'LQ'), #' clampSel = TRUE, algMaxent = "maxnet", parallel = FALSE) #' occsEnvs <- m@@occs diff --git a/R/xfer_userEnvs.R b/R/xfer_userEnvs.R index 3e361998d..c94dd2dca 100644 --- a/R/xfer_userEnvs.R +++ b/R/xfer_userEnvs.R @@ -72,7 +72,7 @@ #' rasName = list.files(system.file("extdata/wc",package = "wallace"), #' pattern = ".tif$", full.names = FALSE)) #' partblock <- part_partitionOccs(occs, bg, method = 'block') -#' m <- model_maxent(occs, bg, user.grp = partblock, bgMsk = envs, rms = c(1:2), +#' m <- model_maxent(occs, bg, user.grp = partblock, bgMsk = terra::rast(envs), rms = c(1:2), #' rmsStep = 1, fcs = c('L', 'LQ'), clampSel = TRUE, algMaxent = "maxnet", parallel = FALSE) #' envsFut <- list.files(path = system.file('extdata/wc/future', #' package = "wallace"), diff --git a/inst/shiny/modules/part_spat.Rmd b/inst/shiny/modules/part_spat.Rmd index a6f37f0da..b8c8963b0 100644 --- a/inst/shiny/modules/part_spat.Rmd +++ b/inst/shiny/modules/part_spat.Rmd @@ -22,6 +22,6 @@ groups_{{spAbr}} <- part_partitionOccs( occs = occs_{{spAbr}} , bg = bgSample_{{spAbr}}, method = "{{method_code_rmd}}", - bgMask = bgMask_{{spAbr}}, + bgMask = raster::stack(bgMask_{{spAbr}}), aggFact = {{aggFact_rmd}}) ``` diff --git a/inst/shiny/modules/penvs_bgExtent.R b/inst/shiny/modules/penvs_bgExtent.R index e27d01395..7e92341eb 100644 --- a/inst/shiny/modules/penvs_bgExtent.R +++ b/inst/shiny/modules/penvs_bgExtent.R @@ -128,7 +128,8 @@ penvs_bgExtent_module_server <- function(input, output, session, common) { bgMask <- penvs_bgMask(spp[[sp]]$occs, envs.global[[spp[[sp]]$envs]], spp[[sp]]$procEnvs$bgExt, logger, spN = sp) req(bgMask) - bgNonNA <- raster::ncell(bgMask) - raster::freq(bgMask, value = NA)[[1]] + bgMaskR <- raster::stack(bgMask) + bgNonNA <- raster::ncell(bgMaskR) - raster::freq(bgMaskR, value = NA)[[1]] if ((bgNonNA + 1) < input$bgPtsNum) { logger %>% writeLog( @@ -138,15 +139,15 @@ penvs_bgExtent_module_server <- function(input, output, session, common) { "(n = ", bgNonNA, "). Please reduce the number of requested points.") return() } - bgPts <- penvs_bgSample(spp[[sp]]$occs, bgMask, input$bgPtsNum, logger, + bgPts <- penvs_bgSample(spp[[sp]]$occs, bgMaskR, input$bgPtsNum, logger, spN = sp) req(bgPts) withProgress( message = paste0("Extracting background values for ", spName(sp), "..."), { - bgEnvsVals <- as.data.frame(raster::extract(bgMask, bgPts)) + bgEnvsVals <- as.data.frame(terra::extract(bgMask, bgPts)) }) - NApoints <- sum(rowSums(is.na(raster::extract(bgMask, spp[[sp]]$occs[ , c("longitude", "latitude")])))) + NApoints <- sum(rowSums(is.na(terra::extract(bgMask, spp[[sp]]$occs[ , c("longitude", "latitude")])))) if (NApoints > 0) { logger %>% writeLog(type = "error", hlSpp(sp), diff --git a/inst/shiny/modules/penvs_bgExtent.Rmd b/inst/shiny/modules/penvs_bgExtent.Rmd index 6e025c15c..81ed2e862 100644 --- a/inst/shiny/modules/penvs_bgExtent.Rmd +++ b/inst/shiny/modules/penvs_bgExtent.Rmd @@ -17,10 +17,10 @@ bgMask_{{spAbr}} <- penvs_bgMask( # Sample background points from the provided area bgSample_{{spAbr}} <- penvs_bgSample( occs = occs_{{spAbr}}, - bgMask = bgMask_{{spAbr}}, + bgMask = raster::stack(bgMask_{{spAbr}}), bgPtsNum = {{bgPtsNum_rmd}}) # Extract values of environmental layers for each background point -bgEnvsVals_{{spAbr}} <- as.data.frame(raster::extract(bgMask_{{spAbr}}, bgSample_{{spAbr}})) +bgEnvsVals_{{spAbr}} <- as.data.frame(terra::extract(bgMask_{{spAbr}}, bgSample_{{spAbr}})) ##Add extracted values to background points table bgEnvsVals_{{spAbr}} <- cbind(scientific_name = paste0("bg_", "{{spName}}"), bgSample_{{spAbr}}, occID = NA, year = NA, institution_code = NA, country = NA, diff --git a/inst/shiny/modules/penvs_drawBgExtent.R b/inst/shiny/modules/penvs_drawBgExtent.R index 364bffe87..06f066eb4 100644 --- a/inst/shiny/modules/penvs_drawBgExtent.R +++ b/inst/shiny/modules/penvs_drawBgExtent.R @@ -127,7 +127,8 @@ penvs_drawBgExtent_module_server <- function(input, output, session, common) { logger, spN = sp) req(bgMask) - bgNonNA <- raster::ncell(bgMask) - raster::freq(bgMask, value = NA)[[1]] + bgMaskR <- raster::stack(bgMask) + bgNonNA <- raster::ncell(bgMaskR) - raster::freq(bgMaskR, value = NA)[[1]] if ((bgNonNA + 1) < input$bgPtsNum) { logger %>% writeLog( @@ -138,17 +139,17 @@ penvs_drawBgExtent_module_server <- function(input, output, session, common) { return() } bgPts <- penvs_bgSample(spp[[sp]]$occs, - bgMask, + bgMaskR, input$bgPtsNum, logger, spN = sp) req(bgPts) withProgress(message = paste0("Extracting background values for ", spName(sp), "..."), { - bgEnvsVals <- as.data.frame(raster::extract(bgMask, bgPts)) + bgEnvsVals <- as.data.frame(terra::extract(bgMask, bgPts)) }) - if (sum(rowSums(is.na(raster::extract(bgMask, spp[[sp]]$occs[ , c("longitude", "latitude")])))) > 0) { + if (sum(rowSums(is.na(terra::extract(bgMask, spp[[sp]]$occs[ , c("longitude", "latitude")])))) > 0) { logger %>% writeLog(type = "error", hlSpp(sp), "One or more occurrence points have NULL raster values.", diff --git a/inst/shiny/modules/penvs_drawBgExtent.Rmd b/inst/shiny/modules/penvs_drawBgExtent.Rmd index 514256ee3..dae36fe23 100644 --- a/inst/shiny/modules/penvs_drawBgExtent.Rmd +++ b/inst/shiny/modules/penvs_drawBgExtent.Rmd @@ -18,10 +18,10 @@ bgMask_{{spAbr}} <- penvs_bgMask( # Sample background points from the provided area bgSample_{{spAbr}} <- penvs_bgSample( occs = occs_{{spAbr}}, - bgMask = bgMask_{{spAbr}}, + bgMask = raster::stack(bgMask_{{spAbr}}), bgPtsNum = {{bgPtsNum_rmd}}) # Extract values of environmental layers for each background point -bgEnvsVals_{{spAbr}} <- as.data.frame(raster::extract(bgMask_{{spAbr}}, bgSample_{{spAbr}})) +bgEnvsVals_{{spAbr}} <- as.data.frame(terra::extract(bgMask_{{spAbr}}, bgSample_{{spAbr}})) ##Add extracted values to background points table bgEnvsVals_{{spAbr}} <- cbind(scientific_name = paste0("bg_", "{{spName}}"), bgSample_{{spAbr}}, occID = NA, year = NA, institution_code = NA, country = NA, diff --git a/inst/shiny/modules/penvs_userBgExtent.R b/inst/shiny/modules/penvs_userBgExtent.R index bb9e4f8af..b0ea984db 100644 --- a/inst/shiny/modules/penvs_userBgExtent.R +++ b/inst/shiny/modules/penvs_userBgExtent.R @@ -148,7 +148,8 @@ penvs_userBgExtent_module_server <- function(input, output, session, common) { logger, spN = sp) req(bgMask) - bgNonNA <- raster::ncell(bgMask) - raster::freq(bgMask, value = NA)[[1]] + bgMaskR <- raster::stack(bgMask) + bgNonNA <- raster::ncell(bgMaskR) - raster::freq(bgMaskR, value = NA)[[1]] if ((bgNonNA + 1) < input$bgPtsNum) { logger %>% writeLog( @@ -159,17 +160,17 @@ penvs_userBgExtent_module_server <- function(input, output, session, common) { return() } bgPts <- penvs_bgSample(spp[[sp]]$occs, - bgMask, + bgMaskR, input$bgPtsNum, logger, spN = sp) req(bgPts) withProgress(message = paste0("Extracting background values for ", spName(sp), "..."), { - bgEnvsVals <- as.data.frame(raster::extract(bgMask, bgPts)) + bgEnvsVals <- as.data.frame(terra::extract(bgMask, bgPts)) }) - if (sum(rowSums(is.na(raster::extract(bgMask, spp[[sp]]$occs[ , c("longitude", "latitude")])))) > 0) { + if (sum(rowSums(is.na(terra::extract(bgMask, spp[[sp]]$occs[ , c("longitude", "latitude")])))) > 0) { logger %>% writeLog(type = "error", hlSpp(sp), "One or more occurrence points have NULL raster values.", diff --git a/inst/shiny/modules/penvs_userBgExtent.Rmd b/inst/shiny/modules/penvs_userBgExtent.Rmd index ff6d1b664..a2c2c386c 100644 --- a/inst/shiny/modules/penvs_userBgExtent.Rmd +++ b/inst/shiny/modules/penvs_userBgExtent.Rmd @@ -21,10 +21,10 @@ bgMask_{{spAbr}} <- penvs_bgMask( # Sample background points from the provided area bgSample_{{spAbr}} <- penvs_bgSample( occs = occs_{{spAbr}}, - bgMask = bgMask_{{spAbr}}, + bgMask = raster::stack(bgMask_{{spAbr}}), bgPtsNum = {{bgPtsNum_rmd}}) # Extract values of environmental layers for each background point -bgEnvsVals_{{spAbr}} <- as.data.frame(raster::extract(bgMask_{{spAbr}}, bgSample_{{spAbr}})) +bgEnvsVals_{{spAbr}} <- as.data.frame(terra::extract(bgMask_{{spAbr}}, bgSample_{{spAbr}})) ##Add extracted values to background points table bgEnvsVals_{{spAbr}} <- cbind(scientific_name = paste0("bg_", "{{spName}}"), bgSample_{{spAbr}}, occID = NA, year = NA, institution_code = NA, country = NA, diff --git a/inst/shiny/modules/vis_mapPreds.R b/inst/shiny/modules/vis_mapPreds.R index 99e379e70..60db30062 100644 --- a/inst/shiny/modules/vis_mapPreds.R +++ b/inst/shiny/modules/vis_mapPreds.R @@ -87,7 +87,7 @@ vis_mapPreds_module_server <- function(input, output, session, common) { # pick the prediction that matches the model selected predSel <- evalOut()@predictions[[curModel()]] predSel <- raster::raster(predSel) - raster::crs(predSel) <- raster::crs(bgMask()) + raster::crs(predSel) <- raster::crs(raster::stack(bgMask())) if(is.na(raster::crs(predSel))) { logger %>% writeLog( type = "error", @@ -103,10 +103,10 @@ vis_mapPreds_module_server <- function(input, output, session, common) { if (spp[[curSp()]]$rmm$model$algorithms == "BIOCLIM") { predType <- "BIOCLIM" m <- evalOut()@models[[curModel()]] - predSel <- dismo::predict(m, terra::rast(bgMask())) + predSel <- dismo::predict(m, bgMask()) predSel <- raster::raster(predSel) # define crs - raster::crs(predSel) <- raster::crs(bgMask()) + raster::crs(predSel) <- raster::crs(raster::raster(bgMask())) # define predSel name names(predSel) <- curModel() } else if (spp[[curSp()]]$rmm$model$algorithms %in% c("maxent.jar", "maxnet")) { @@ -125,7 +125,7 @@ vis_mapPreds_module_server <- function(input, output, session, common) { clamping <- spp[[curSp()]]$rmm$model$algorithm$maxent$clamping if (spp[[curSp()]]$rmm$model$algorithms == "maxnet") { if (predType == "raw") predType <- "exponential" - predSel <- predictMaxnet(m, bgMask(), + predSel <- predictMaxnet(m, raster::stack(bgMask()), type = predType, clamp = FALSE) } else if (spp[[curSp()]]$rmm$model$algorithms == "maxent.jar") { @@ -135,7 +135,7 @@ vis_mapPreds_module_server <- function(input, output, session, common) { } else { doClamp <- "doclamp=false" } - predSel <- dismo::predict(m, terra::rast(bgMask()), + predSel <- dismo::predict(m, bgMask(), args = c(outputFormat, doClamp), #na.rm = TRUE ) @@ -143,7 +143,7 @@ vis_mapPreds_module_server <- function(input, output, session, common) { } }) # define crs - raster::crs(predSel) <- raster::crs(bgMask()) + raster::crs(predSel) <- raster::crs(raster::stack(bgMask())) # define predSel name names(predSel) <- curModel() diff --git a/inst/shiny/modules/vis_mapPreds.Rmd b/inst/shiny/modules/vis_mapPreds.Rmd index 5f67b8627..beacf66f4 100644 --- a/inst/shiny/modules/vis_mapPreds.Rmd +++ b/inst/shiny/modules/vis_mapPreds.Rmd @@ -7,7 +7,7 @@ Generate a map of the Bioclim generated model with no threshold # Select current model and obtain raster prediction m_{{spAbr}} <- model_{{spAbr}}@models[["{{curModel_rmd}}"]] -predSel_{{spAbr}} <- dismo::predict(m_{{spAbr}}, terra::rast(bgMask_{{spAbr}})) +predSel_{{spAbr}} <- dismo::predict(m_{{spAbr}}, bgMask_{{spAbr}}) predSel_{{spAbr}} <- raster::raster(predSel_{{spAbr}}) #Get values of prediction mapPredVals_{{spAbr}} <- getRasterVals(predSel_{{spAbr}}, "{{predType_rmd}}") @@ -43,7 +43,7 @@ Generate a map of the Bioclim generated model with a "{{thresholdRule_rmd}}" thr ```{r, echo = {{vis_mapPreds_knit & vis_map_bioclim_knit & vis_map_threshold_knit}}, include = {{vis_mapPreds_knit & vis_map_bioclim_knit & vis_map_threshold_knit}}} # Select current model and obtain raster prediction m_{{spAbr}} <- model_{{spAbr}}@models[["{{curModel_rmd}}"]] -predSel_{{spAbr}} <- dismo::predict(m_{{spAbr}}, terra::rast(bgMask_{{spAbr}})) +predSel_{{spAbr}} <- dismo::predict(m_{{spAbr}}, bgMask_{{spAbr}}) predSel_{{spAbr}} <- raster::raster(predSel_{{spAbr}}) # extract the suitability values for all occurrences occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')] @@ -93,7 +93,7 @@ Generate a map of the Maxent generated model with no threshold # Select current model and obtain raster prediction m_{{spAbr}} <- model_{{spAbr}}@models[["{{curModel_rmd}}"]] predSel_{{spAbr}} <- dismo::predict( - m_{{spAbr}}, terra::rast(bgMask_{{spAbr}}), + m_{{spAbr}}, bgMask_{{spAbr}}, args = c(paste0("outputformat=", "{{predType_rmd}}"), paste0("doclamp=", tolower(as.character({{clamp_rmd}}))))) predSel_{{spAbr}} <- raster::raster(predSel_{{spAbr}}) @@ -132,7 +132,7 @@ Generate a map of the Maxent generated model with a "{{thresholdRule_rmd}}" thre # Select current model and obtain raster prediction m_{{spAbr}} <- model_{{spAbr}}@models[["{{curModel_rmd}}"]] predSel_{{spAbr}} <- dismo::predict( - m_{{spAbr}}, terra::rast(bgMask_{{spAbr}}), + m_{{spAbr}}, bgMask_{{spAbr}}, args = c(paste0("outputformat=", "{{predType_rmd}}"), paste0("doclamp=", tolower(as.character({{clamp_rmd}}))))) predSel_{{spAbr}} <- raster::raster(predSel_{{spAbr}}) @@ -181,7 +181,7 @@ Generate a map of the maxnet generated model with no threshold ```{r, echo = {{vis_mapPreds_knit & vis_map_maxnet_knit & !vis_map_threshold_knit}}, include = {{vis_mapPreds_knit & vis_map_maxnet_knit & !vis_map_threshold_knit}}} # Select current model and obtain raster prediction m_{{spAbr}} <- model_{{spAbr}}@models[["{{curModel_rmd}}"]] -predSel_{{spAbr}} <- predictMaxnet(m_{{spAbr}}, bgMask_{{spAbr}}, +predSel_{{spAbr}} <- predictMaxnet(m_{{spAbr}}, raster(bgMask_{{spAbr}}), type = "{{predType_rmd}}", clamp = {{clamp_rmd}}) #Get values of prediction @@ -218,7 +218,7 @@ Generate a map of the maxnet generated model with with a "{{thresholdRule_rmd}}" ```{r, echo = {{vis_mapPreds_knit & vis_map_maxnet_knit & vis_map_threshold_knit}}, include = {{vis_mapPreds_knit & vis_map_maxnet_knit & vis_map_threshold_knit}}} # Select current model and obtain raster prediction m_{{spAbr}} <- model_{{spAbr}}@models[["{{curModel_rmd}}"]] -predSel_{{spAbr}} <- predictMaxnet(m_{{spAbr}}, bgMask_{{spAbr}}, +predSel_{{spAbr}} <- predictMaxnet(m_{{spAbr}}, raster(bgMask_{{spAbr}}), type = "{{predType_rmd}}", clamp = {{clamp_rmd}}) # extract the suitability values for all occurrences diff --git a/inst/shiny/modules/xfer_mess.R b/inst/shiny/modules/xfer_mess.R index 4119c0572..7cbee814a 100644 --- a/inst/shiny/modules/xfer_mess.R +++ b/inst/shiny/modules/xfer_mess.R @@ -58,10 +58,10 @@ xfer_mess_module_server <- function(input, output, session, common) { # FUNCTION CALL #### xferYr <- spp[[curSp()]]$rmm$data$transfer$environment1$yearMax if (spp[[curSp()]]$rmm$model$algorithms == "BIOCLIM") { - mss <- xfer_mess(occs(), bg = NULL, bgMask(), spp[[curSp()]]$transfer$xfEnvs, + mss <- xfer_mess(occs(), bg = NULL, raster::stack(bgMask()), spp[[curSp()]]$transfer$xfEnvs, logger, spN = curSp()) } else { - mss <- xfer_mess(occs(), bg(), bgMask(), spp[[curSp()]]$transfer$xfEnvs, + mss <- xfer_mess(occs(), bg(), raster::stack(bgMask()), spp[[curSp()]]$transfer$xfEnvs, logger, spN = curSp()) } diff --git a/inst/shiny/modules/xfer_mess.Rmd b/inst/shiny/modules/xfer_mess.Rmd index 0630c96f2..172177135 100644 --- a/inst/shiny/modules/xfer_mess.Rmd +++ b/inst/shiny/modules/xfer_mess.Rmd @@ -7,7 +7,7 @@ Generate a MESS map for the transferring variables given the variables used for xferMess_{{spAbr}} <- xfer_mess( occs = occs_{{spAbr}}, bg = bgEnvsVals_{{spAbr}} , - bgMsk = bgMask_{{spAbr}}, + bgMsk = raster::stack(bgMask_{{spAbr}}), xferExtRas = xferExt_{{spAbr}}) # Generate MESS map diff --git a/inst/shiny/modules/xfer_time.Rmd b/inst/shiny/modules/xfer_time.Rmd index e5b6ab3d5..31041ebeb 100644 --- a/inst/shiny/modules/xfer_time.Rmd +++ b/inst/shiny/modules/xfer_time.Rmd @@ -4,18 +4,19 @@ Transferring the model to the same modelling area with no threshold rule. New ti ``` ```{r, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}} -#Download variables for transferring +#Download variables for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", - res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), + res = round((raster::res(bgMaskR_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling -xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] +xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMaskR_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) @@ -64,18 +65,19 @@ Transferring the model to the same modelling area with a "{{xfer_thresholdRule_r ``` ```{r, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}} -#Download variables for transferring +#Download variables for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", - res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), + res = round((raster::res(bgMaskR_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling -xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] +xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMaskR_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) @@ -134,18 +136,19 @@ Transferring the model to a user drawn area with no threshold. New time based on ``` ```{r, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}} -#Download variables for transferring +#Download variables for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", - res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), + res = round((raster::res(bgMaskR_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling -xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] +xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMaskR_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) @@ -201,18 +204,19 @@ Transferring the model to a user drawn area with a "{{xfer_thresholdRule_rmd}}" ``` ```{r, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}} -#Download variables for transferring +#Download variables for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", - res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), + res = round((raster::res(bgMaskR_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling -xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] +xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMaskR_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) @@ -277,18 +281,19 @@ Transferring the model to a user provided area area with no threshold. New time ```{r, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}} -# Download variables for transferring +# Download variables for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", - res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), + res = round((raster::res(bgMaskR_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling -xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] +xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMaskR_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) @@ -347,17 +352,18 @@ Transferring the model to a user provided area with a "{{xfer_thresholdRule_rmd} ```{r, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}} # Download variables for transferring from Worldclim +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", - res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), + res = round((raster::res(bgMaskR_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling -xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] +xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMaskR_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) @@ -425,10 +431,11 @@ Transferring the model to the same modelling area with no threshold rule. New ti ```{r, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", - as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) + as.numeric(gsub("bio", "", names(bgMaskR_{{spAbr}})))) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( @@ -477,10 +484,11 @@ Transferring the model to the same modelling area with a "{{xfer_thresholdRule_r ```{r, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", - as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) + as.numeric(gsub("bio", "", names(bgMaskR_{{spAbr}})))) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( @@ -539,10 +547,11 @@ Transferring the model to a user drawn area with no threshold rule. New time bas ```{r, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", - as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) + as.numeric(gsub("bio", "", names(bgMaskR_{{spAbr}})))) # Generate the area of transfer according to the drawn polygon in the GUI xfer_draw_{{spAbr}} <-xfer_draw( @@ -597,10 +606,11 @@ Transferring the model to a user drawn area with a "{{xfer_thresholdRule_rmd}}" ```{r, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", - as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) + as.numeric(gsub("bio", "", names(bgMaskR_{{spAbr}})))) # Generate the area of transfer according to the drawn polygon in the GUI xfer_draw_{{spAbr}} <-xfer_draw( @@ -665,10 +675,11 @@ Transferring the model to a user provided area with no threshold rule. New time ```{r, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", - as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) + as.numeric(gsub("bio", "", names(bgMaskR_{{spAbr}})))) # Generate the area of transfer based on user provided files ##User must input the path to shapefile or csv file and the file name @@ -726,10 +737,11 @@ Transferring the model to a user provided area with a "{{xfer_thresholdRule_rmd} ```{r, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring +bgMaskR_{{spAbr}} <- raster::stack(bgMask_{{spAbr}}) xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", - as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) + as.numeric(gsub("bio", "", names(bgMaskR_{{spAbr}})))) # Generate the area of transfer based on user provided files ##User must input the path to shapefile or csv file and the file name diff --git a/inst/shiny/server.R b/inst/shiny/server.R index b274e2ac6..f849d35de 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -444,7 +444,7 @@ function(input, output, session) { type <- input$bgMskFileType nm <- names(envs()) - raster::writeRaster(bgMask(), nm, bylayer = TRUE, + raster::writeRaster(raster::stack(bgMask()), nm, bylayer = TRUE, format = type, overwrite = TRUE) ext <- switch(type, raster = 'grd', ascii = 'asc', GTiff = 'tif') @@ -801,7 +801,7 @@ function(input, output, session) { logger %>% writeLog(type = "error", "To download PNG prediction, you're required to", " install PhantomJS in your machine. You can use webshot::install_phantomjs()", - " in you are R console.") + " in your R console.") return() } if (!requireNamespace("mapview")) { @@ -954,7 +954,7 @@ function(input, output, session) { logger %>% writeLog(type = "error", "To download PNG prediction, you're required to", " install PhantomJS in your machine. You can use webshot::install_phantomjs()", - " in you are R console.") + " in your R console.") return() } if (!requireNamespace("mapview")) { @@ -1044,7 +1044,7 @@ function(input, output, session) { logger %>% writeLog(type = "error", "To download PNG prediction, you're required to", " install PhantomJS in your machine. You can use webshot::install_phantomjs()", - " in you are R console.") + " in your R console.") return() } if (!requireNamespace("mapview")) { diff --git a/tests/testthat/test_model_bioclim.R b/tests/testthat/test_model_bioclim.R index e1d546e53..a5b1ba09a 100644 --- a/tests/testthat/test_model_bioclim.R +++ b/tests/testthat/test_model_bioclim.R @@ -14,7 +14,7 @@ occs <- read.csv(system.file("extdata/Bassaricyon_alleni.csv", bg <- read.csv(system.file("extdata/Bassaricyon_alleni_bgPoints.csv", package = "wallace")) partblock <- part_partitionOccs(occs, bg, method = 'block') -bioclimAlg <- model_bioclim(occs, bg, partblock, envs) +bioclimAlg <- model_bioclim(occs, bg, partblock, terra::rast(envs)) ### test output features test_that("output type checks", { diff --git a/tests/testthat/test_model_maxent.R b/tests/testthat/test_model_maxent.R index e9be364eb..a5d22d1a9 100644 --- a/tests/testthat/test_model_maxent.R +++ b/tests/testthat/test_model_maxent.R @@ -32,7 +32,7 @@ jar_f <- paste(system.file(package = "dismo"), "/maxent.jar", sep = '') ## test if the error messages appear when they are supposed to test_that("error checks", { # user has not partitioned occurrences - expect_error(model_maxent(occs, bg, bgMsk = envs, user.grp = NULL, + expect_error(model_maxent(occs, bg, bgMsk = terra::rest(envs), user.grp = NULL, rms, rmsStep, fcs, clampSel = TRUE, algMaxent = algorithm[1]), paste0("Before building a model, please partition occurrences ", @@ -47,7 +47,7 @@ for (i in algorithm) { ### run function maxentAlg <- model_maxent(occs = occs, bg = bg, user.grp = partblock, - bgMsk = envs, rms, rmsStep, fcs, clampSel = TRUE, + bgMsk = terra::rast(envs), rms, rmsStep, fcs, clampSel = TRUE, algMaxent = i, parallel = FALSE) test_that("output type checks", { diff --git a/tests/testthat/test_penvs_bgMask.R b/tests/testthat/test_penvs_bgMask.R index 1a7d1300d..61b02f4bd 100644 --- a/tests/testthat/test_penvs_bgMask.R +++ b/tests/testthat/test_penvs_bgMask.R @@ -11,7 +11,9 @@ envs <- envs_userEnvs(rasPath = list.files(system.file("extdata/wc", rasName = list.files(system.file("extdata/wc", package = "wallace"), pattern = ".tif$", full.names = FALSE)) +crs(envs) <- "EPSG:4326" bgExt <- penvs_bgExtent(occs, bgSel = 'minimum convex polygon', bgBuf = 0.5) +crs(bgExt) <- "EPSG:4326" bgMask <- penvs_bgMask(occs, envs, bgExt) @@ -24,21 +26,21 @@ test_that("error checks", { ### test output features test_that("output type checks", { - # the output is a RasterBrick - expect_is(bgMask, "RasterBrick") + # the output is a SpatRaster + expect_is(bgMask, "SpatRaster") # the amount of masked layers are the same as uploaded in the comp. 3 - expect_equal(raster::nlayers(envs), raster::nlayers(bgMask)) + expect_equal(raster::nlayers(envs), nlyr(bgMask)) # the masked layers are the same as uploaded in the comp. 3 expect_equal(names(bgMask), names(envs)) # all the environmental layers have the same amount of pixels - expect_equal(raster::cellStats(bgMask, sum), raster::cellStats(bgMask, sum)) + expect_equal(terra::ncell(bgMask), raster::ncell(envs)) # the original layers have more pixels than the masked ones expect_true( - raster::cellStats(bgMask$bio05, sum) < raster::cellStats(envs$bio05, sum)) + terra::global(bgMask$bio05, "notNA") < raster::ncell(envs$bio05)) expect_true( - raster::cellStats(bgMask$bio06, sum) < raster::cellStats(envs$bio06, sum)) + terra::global(bgMask$bio06, "notNA") < raster::ncell(envs$bio06)) expect_true( - raster::cellStats(bgMask$bio13, sum) < raster::cellStats(envs$bio13, sum)) + terra::global(bgMask$bio13, "notNA") < raster::ncell(envs$bio13)) expect_true( - raster::cellStats(bgMask$bio14, sum) < raster::cellStats(envs$bio14, sum)) + terra::global(bgMask$bio14, "notNA") < raster::ncell(envs$bio14)) }) diff --git a/tests/testthat/test_penvs_bgSample.R b/tests/testthat/test_penvs_bgSample.R index 16b78db8b..54e6def33 100644 --- a/tests/testthat/test_penvs_bgSample.R +++ b/tests/testthat/test_penvs_bgSample.R @@ -17,14 +17,15 @@ envs <- envs_userEnvs(rasPath = list.files(system.file("extdata/wc", bgExt <- penvs_bgExtent(occs, bgSel = 'bounding box', bgBuf = 0.5) # background masked bgMask <- penvs_bgMask(occs, envs, bgExt) +bgMaskR <- raster::stack(bgMask) ## Number of background points to sample bgPtsNum <- 100 bgPtsNum_big <- 19525 ### run function -bgsample <- penvs_bgSample(occs, bgMask, bgPtsNum) -bgsample_big <- penvs_bgSample(occs, bgMask, bgPtsNum_big) +bgsample <- penvs_bgSample(occs, bgMaskR, bgPtsNum) +bgsample_big <- penvs_bgSample(occs, bgMaskR, bgPtsNum_big) ### test output features test_that("output type checks", { @@ -41,7 +42,7 @@ test_that("output type checks", { # bgPtsNum is bigger than available expect_equal( nrow(bgsample_big), - (raster::ncell(bgMask) - raster::freq(bgMask, value = NA)[[1]])) + (raster::ncell(bgMaskR) - raster::freq(bgMaskR, value = NA)[[1]])) # check if all the points sampled overlap with the study region # set longitude and latitude diff --git a/tests/testthat/test_vis_bioclimPlot.R b/tests/testthat/test_vis_bioclimPlot.R index 148e40088..b754d3f7f 100644 --- a/tests/testthat/test_vis_bioclimPlot.R +++ b/tests/testthat/test_vis_bioclimPlot.R @@ -16,7 +16,7 @@ occs <- read.csv(system.file("extdata/Bassaricyon_alleni.csv", bg <- read.csv(system.file("extdata/Bassaricyon_alleni_bgPoints.csv", package = "wallace")) partblock <- part_partitionOccs(occs, bg, method = 'block') -m <- model_bioclim(occs, bg, partblock, envs) +m <- model_bioclim(occs, bg, partblock, terra::rast(envs)) ### run function bioclimPlot <- vis_bioclimPlot(x = m@models$bioclim, a = 2, b = 3, diff --git a/tests/testthat/test_xfer_area.R b/tests/testthat/test_xfer_area.R index 71256bca4..cc3fa437e 100644 --- a/tests/testthat/test_xfer_area.R +++ b/tests/testthat/test_xfer_area.R @@ -27,7 +27,7 @@ bg <- read.csv(system.file("extdata/Bassaricyon_alleni_bgPoints.csv", package = "wallace")) partblock <- part_partitionOccs(occs, bg, method = 'block') m <- model_maxent(occs, bg, user.grp = partblock, - bgMsk = envs, rms = c(1:2), rmsStep = 1, fcs = c('L', 'LQ'), + bgMsk = terra::rast(envs), rms = c(1:2), rmsStep = 1, fcs = c('L', 'LQ'), clampSel = TRUE, algMaxent = "maxnet", parallel = FALSE) diff --git a/tests/testthat/test_xfer_time.R b/tests/testthat/test_xfer_time.R index 836ff6b22..0fdd8b32f 100644 --- a/tests/testthat/test_xfer_time.R +++ b/tests/testthat/test_xfer_time.R @@ -23,7 +23,7 @@ bg <- read.csv(system.file("extdata/Bassaricyon_alleni_bgPoints.csv", package = "wallace")) partblock <- part_partitionOccs(occs, bg, method = 'block') m <- model_maxent(occs, bg, user.grp = partblock, - bgMsk = envs, rms = c(1:2), rmsStep = 1, fcs = c('L', 'LQ'), + bgMsk = terra::rast(envs), rms = c(1:2), rmsStep = 1, fcs = c('L', 'LQ'), clampSel = TRUE, algMaxent = "maxnet", parallel = FALSE) diff --git a/tests/testthat/test_xfer_userEnvs.R b/tests/testthat/test_xfer_userEnvs.R index 675b739ae..03e864fbf 100644 --- a/tests/testthat/test_xfer_userEnvs.R +++ b/tests/testthat/test_xfer_userEnvs.R @@ -23,7 +23,7 @@ envs <- envs_userEnvs(rasPath = list.files(system.file("extdata/wc", pattern = ".tif$", full.names = FALSE)) partblock <- part_partitionOccs(occs, bg, method = 'block') m <- model_maxent(occs, bg, user.grp = partblock, - bgMsk = envs, rms = c(1:2), rmsStep = 1, fcs = c('L', 'LQ'), + bgMsk = terra::rast(envs), rms = c(1:2), rmsStep = 1, fcs = c('L', 'LQ'), clampSel = TRUE, algMaxent = "maxnet", parallel = FALSE) envsFut <- list.files(path = system.file('extdata/wc/future', From f5cf1073a0c67e7c225bc83cd13630a1b36ee355 Mon Sep 17 00:00:00 2001 From: Daniel Lopez Date: Thu, 22 Jan 2026 15:26:18 -0500 Subject: [PATCH 2/2] Add test case for categorical variables in MaxEnt --- R/model_maxent.R | 1 + tests/testthat/test_model_maxent.R | 12 ++++++++++++ tests/testthat/test_penvs_bgMask.R | 6 ++++-- 3 files changed, 17 insertions(+), 2 deletions(-) diff --git a/R/model_maxent.R b/R/model_maxent.R index 594dca465..a0914e56d 100644 --- a/R/model_maxent.R +++ b/R/model_maxent.R @@ -86,6 +86,7 @@ #' @author Jamie M. Kass #' @author Gonzalo E. Pinilla-Buitrago #' @author Bethany A. Johnson +#' @author Daniel Lopez-Lozano # @note #' @seealso \code{\link[ENMeval]{ENMevaluate}} diff --git a/tests/testthat/test_model_maxent.R b/tests/testthat/test_model_maxent.R index a5d22d1a9..c668fcabc 100644 --- a/tests/testthat/test_model_maxent.R +++ b/tests/testthat/test_model_maxent.R @@ -9,6 +9,11 @@ envs <- envs_userEnvs(rasPath = list.files(system.file("extdata/wc", rasName = list.files(system.file("extdata/wc", package = "wallace"), pattern = ".tif$", full.names = FALSE)) + +# Includes one categorical variable +envsCat <- terra::rast(list.files(system.file('/ex', package='predicts'), + pattern='tif$', full.names=TRUE)) + occs <- read.csv(system.file("extdata/Bassaricyon_alleni.csv", package = "wallace")) bg <- read.csv(system.file("extdata/Bassaricyon_alleni_bgPoints.csv", @@ -49,10 +54,17 @@ for (i in algorithm) { maxentAlg <- model_maxent(occs = occs, bg = bg, user.grp = partblock, bgMsk = terra::rast(envs), rms, rmsStep, fcs, clampSel = TRUE, algMaxent = i, parallel = FALSE) + # run function with one categorical variable + maxentAlg2 <- model_maxent(occs = occs, bg = bg, user.grp = partblock, + bgMsk = envsCat, rms, rmsStep, fcs, clampSel = TRUE, + algMaxent = i, catEnvs = 'biome', parallel = FALSE) test_that("output type checks", { # the output is an ENMeval object expect_is(maxentAlg, "ENMevaluation") + # output using categorical variables is not null and is an ENMeval object + expect_true(!is.null(maxentAlg2)) + expect_is(maxentAlg2, "ENMevaluation") #the output has 9 slots with correct names expect_equal(length(slotNames(maxentAlg)), 20) expect_equal(slotNames(maxentAlg), diff --git a/tests/testthat/test_penvs_bgMask.R b/tests/testthat/test_penvs_bgMask.R index 61b02f4bd..76024ea55 100644 --- a/tests/testthat/test_penvs_bgMask.R +++ b/tests/testthat/test_penvs_bgMask.R @@ -1,6 +1,7 @@ #### COMPONENT penvs: Process Environmental Data #### MODULE: Select Study Region context("bgMask") +library("terra") occs <- read.csv(system.file("extdata/Bassaricyon_alleni.csv", package = "wallace"))[, 2:3] @@ -11,9 +12,10 @@ envs <- envs_userEnvs(rasPath = list.files(system.file("extdata/wc", rasName = list.files(system.file("extdata/wc", package = "wallace"), pattern = ".tif$", full.names = FALSE)) -crs(envs) <- "EPSG:4326" + +raster::crs(envs) <- "EPSG:4326" bgExt <- penvs_bgExtent(occs, bgSel = 'minimum convex polygon', bgBuf = 0.5) -crs(bgExt) <- "EPSG:4326" +raster::crs(bgExt) <- "EPSG:4326" bgMask <- penvs_bgMask(occs, envs, bgExt)