Skip to content

Commit 9bcf016

Browse files
author
rpatin
committedApr 18, 2023
fixed user-defined PA.table with filter.raster = TRUE
1 parent 9daa9c3 commit 9bcf016

File tree

6 files changed

+68
-62
lines changed

6 files changed

+68
-62
lines changed
 

‎R/biomod2_classes_1.R

+52-49
Original file line numberDiff line numberDiff line change
@@ -188,7 +188,7 @@ setGeneric("BIOMOD.formated.data", def = function(sp, env, ...) { standardGeneri
188188
available.types.resp <- c('integer', 'numeric', 'data.frame', 'matrix',
189189
'SpatialPointsDataFrame', 'SpatialPoints', 'SpatVector')
190190
.fun_testIfInherits(TRUE, "sp", sp, available.types.resp)
191-
191+
192192
## SpatialPoints, SpatialPointsDataFrame, SpatVector
193193
if (inherits(sp, c('SpatialPoints','SpatVector'))) {
194194
.tmp <- .check_formating_spatial(resp.var = sp,
@@ -934,7 +934,7 @@ setMethod('plot', signature(x = 'BIOMOD.formated.data', y = "missing"),
934934
allPA <- allrun <- NA
935935
if (!is.null(calib.lines)) {
936936
.fun_testIfInherits(TRUE, "calib.lines", calib.lines, c("matrix"))
937-
937+
938938
expected_CVnames <- c(paste0("_allData_RUN", seq_len(ncol(calib.lines))), "_allData_allRun")
939939
if (inherits(x, "BIOMOD.formated.data.PA")) {
940940
expected_CVnames <- c(expected_CVnames
@@ -1170,20 +1170,20 @@ setMethod('summary', signature(object = 'BIOMOD.formated.data'),
11701170
output <- data.frame("dataset" = "initial",
11711171
"run" = NA,
11721172
"PA" = NA,
1173-
"Presences" = sum(object@data.species, na.rm = TRUE),
1174-
"True_Absences" = sum(object@data.species == 0, na.rm = TRUE),
1173+
"Presences" = length(which(object@data.species == 1)),
1174+
"True_Absences" = length(which(object@data.species == 0)),
11751175
"Pseudo_Absences" = 0,
1176-
"Undefined" = sum(is.na(object@data.species), na.rm = TRUE))
1176+
"Undefined" = length(which(is.na(object@data.species))))
11771177

11781178
if (object@has.data.eval) {
11791179
output <- rbind(output,
11801180
data.frame("dataset" = "evaluation",
11811181
"run" = NA,
11821182
"PA" = NA,
1183-
"Presences" = sum(object@eval.data.species, na.rm = TRUE),
1184-
"True_Absences" = sum(object@eval.data.species == 0, na.rm = TRUE),
1183+
"Presences" = length(which(object@eval.data.species == 1)),
1184+
"True_Absences" = length(which(object@eval.data.species == 0)),
11851185
"Pseudo_Absences" = 0,
1186-
"Undefined" = sum(is.na(object@eval.data.species), na.rm = TRUE)))
1186+
"Undefined" = length(which(is.na(object@eval.data.species)))))
11871187
}
11881188

11891189
PA <- run <- NA
@@ -1199,47 +1199,48 @@ setMethod('summary', signature(object = 'BIOMOD.formated.data'),
11991199
output <-
12001200
rbind(
12011201
output,
1202-
foreach(this_PA = PA, this_run = run, .combine = 'rbind') %do% {
1203-
if (is.na(this_PA) || this_PA == 'allData') { # run only
1204-
this_name <- paste0("_", this_PA, "_", this_run)
1205-
this_calib <- calib.lines[ , this_name]
1206-
this_valid <- ! calib.lines[ , this_name]
1207-
} else if (is.na(this_run)) { # PA only
1208-
this_calib <- object@PA.table[ , this_PA]
1209-
} else { # PA+run
1210-
this_name <- paste0("_", this_PA, "_", this_run)
1211-
this_calib <- calib.lines[ , this_name] & object@PA.table[ , this_PA]
1212-
this_valid <- ! calib.lines[ , this_name] & object@PA.table[ , this_PA]
1213-
}
1214-
calib.resp <- object@data.species[which(this_calib)]
1215-
tmp <- data.frame("dataset" = "calibration",
1216-
"run" = this_run,
1217-
"PA" = this_PA,
1218-
"Presences" = length(which(calib.resp == 1)),
1219-
"True_Absences" = length(which(calib.resp == 0)),
1220-
"Pseudo_Absences" =
1221-
length(which(this_calib)) -
1222-
length(which(calib.resp == 1)) -
1223-
length(which(calib.resp == 0)),
1224-
"Undefined" = NA)
1225-
1226-
if (!is.na(this_run)) {
1227-
valid.resp <- object@data.species[this_valid]
1228-
tmp <- rbind(tmp,
1229-
data.frame("dataset" = "validation",
1230-
"run" = this_run,
1231-
"PA" = this_PA,
1232-
"Presences" = length(which(valid.resp == 1)),
1233-
"True_Absences" = length(which(valid.resp == 0)),
1234-
"Pseudo_Absences" =
1235-
length(valid.resp) -
1236-
length(which(valid.resp == 1)) -
1237-
length(which(valid.resp == 0)),
1238-
"Undefined" = NA))
1202+
foreach(this_run = run, .combine = 'rbind') %:%
1203+
foreach(this_PA = PA, .combine = 'rbind') %do% {
1204+
if (is.na(this_PA) || this_PA == 'allData') { # run only
1205+
this_name <- paste0("_", this_PA, "_", this_run)
1206+
this_calib <- calib.lines[ , this_name]
1207+
this_valid <- ! calib.lines[ , this_name]
1208+
} else if (is.na(this_run)) { # PA only
1209+
this_calib <- object@PA.table[ , this_PA]
1210+
} else { # PA+run
1211+
this_name <- paste0("_", this_PA, "_", this_run)
1212+
this_calib <- calib.lines[ , this_name] & object@PA.table[ , this_PA]
1213+
this_valid <- ! calib.lines[ , this_name] & object@PA.table[ , this_PA]
1214+
}
1215+
calib.resp <- object@data.species[which(this_calib)]
1216+
tmp <- data.frame("dataset" = "calibration",
1217+
"run" = this_run,
1218+
"PA" = this_PA,
1219+
"Presences" = length(which(calib.resp == 1)),
1220+
"True_Absences" = length(which(calib.resp == 0)),
1221+
"Pseudo_Absences" =
1222+
length(which(this_calib)) -
1223+
length(which(calib.resp == 1)) -
1224+
length(which(calib.resp == 0)),
1225+
"Undefined" = NA)
12391226

1240-
}
1241-
return(tmp) # end foreach
1242-
})
1227+
if (!is.na(this_run)) {
1228+
valid.resp <- object@data.species[this_valid]
1229+
tmp <- rbind(tmp,
1230+
data.frame("dataset" = "validation",
1231+
"run" = this_run,
1232+
"PA" = this_PA,
1233+
"Presences" = length(which(valid.resp == 1)),
1234+
"True_Absences" = length(which(valid.resp == 0)),
1235+
"Pseudo_Absences" =
1236+
length(valid.resp) -
1237+
length(which(valid.resp == 1)) -
1238+
length(which(valid.resp == 0)),
1239+
"Undefined" = NA))
1240+
1241+
}
1242+
return(tmp) # end foreach
1243+
})
12431244
}
12441245
output
12451246
}
@@ -1488,9 +1489,11 @@ setMethod('BIOMOD.formated.data.PA', signature(sp = 'numeric', env = 'SpatRaster
14881489
if (inherits(env, 'SpatRaster')) {
14891490
categorical_var <- names(env)[is.factor(env)]
14901491

1491-
output <- check_duplicated_cells(env, xy, sp, filter.raster)
1492+
output <- check_duplicated_cells(env, xy, sp, filter.raster,
1493+
PA.user.table = PA.user.table)
14921494
xy <- output$xy
14931495
sp <- output$sp
1496+
PA.user.table <- output$PA.user.table
14941497
rm(output)
14951498
}
14961499

‎R/biomod2_internal.R

+9-4
Original file line numberDiff line numberDiff line change
@@ -809,12 +809,16 @@ rast.has.values <- function(x){
809809
##'
810810
##' @importFrom terra cellFromXY
811811

812-
check_duplicated_cells <- function(env, xy, sp, filter.raster){
812+
check_duplicated_cells <- function(env, xy, sp, filter.raster,
813+
PA.user.table = NULL){
813814
sp.cell <- duplicated(cellFromXY(env, xy))
814-
if(any(sp.cell)){
815-
if(filter.raster){
815+
if (any(sp.cell)) {
816+
if (filter.raster) {
816817
sp <- sp[!sp.cell]
817818
xy <- xy[!sp.cell,]
819+
if (!is.null(PA.user.table)) {
820+
PA.user.table <- PA.user.table[!sp.cell, , drop = FALSE]
821+
}
818822
cat("\n !!! Some data are located in the same raster cell.
819823
Only the first data in each cell will be kept as `filter.raster = TRUE`.")
820824
} else {
@@ -823,7 +827,8 @@ check_duplicated_cells <- function(env, xy, sp, filter.raster){
823827
}
824828
}
825829
return(list("sp" = sp,
826-
"xy" = xy))
830+
"xy" = xy,
831+
"PA.user.table" = PA.user.table))
827832

828833
}
829834

‎docs/articles/news.html

+3-4
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎docs/reference/check_duplicated_cells.html

+1-1
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/check_duplicated_cells.Rd

+1-1
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎vignettes/news.Rmd

+2-3
Original file line numberDiff line numberDiff line change
@@ -41,10 +41,9 @@ vignette: >
4141
* Correct print for multiple values in `RF$sampsize` parameter in `BIOMOD_ModelingOptions`
4242
* Fixed layer name in `BIOMOD_Projection` and `BIOMOD_EnsembleForecasting` when `terraOption(todisk = TRUE)` is activated (for large or numerous raster).
4343
* fixed Ensemble Models based on models without cross-validation ("allRun")
44-
* model is now robust to using `data.table` object (that are converted into standard `data.frame`)
44+
* model is now robust to using `data.table` object (that are converted into standard `data.frame`).
4545
* fixed projection raster name when using `do.stack = FALSE` and `resp.name` with `.` inside.
46-
* Added `na.rm` argument to `BIOMOD_EnsembleForecasting` to harmonize `NA`
47-
management among individual model predictions.
46+
* fixed using user-defined pseudo-absences along with `filter.raster = TRUE` in `bm_PseudoAbsence`.
4847

4948
##### Internal
5049

0 commit comments

Comments
 (0)
Please sign in to comment.