# biodivMapR2 v2.4.5

jbferet · jbferet · commit bed6b0d6d7a8 · 2026-02-03T18:43:08.000+01:00
## change
- biodivMapR_full_classif: add possibility to set compute_beta = TRUE or FALSE
- remove TODO.md
- use regular expression '\\.' when searching for strings including '.':
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: biodivMapR
 Title: biodivMapR: an R package for a- and ß-diversity mapping using remotely-sensed images
-Version: 2.4.4
+Version: 2.4.5
 Authors@R: c(person(given = "Jean-Baptiste", 
 					family = "Feret", 
 					email = "jb.feret@teledetection.fr", 
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,9 @@
+# biodivMapR2 v2.4.5
+## change
+- biodivMapR_full_classif: add possibility to set compute_beta = TRUE or FALSE 
+- remove TODO.md
+- use regular expression '\\.' when searching for strings including '.': 
+
 # biodivMapR2 v2.4.4
 ## fix
 - use lapply instead of future_lapply when calling 'functional_window_list' in 'get_raster_diversity_tile'
diff --git a/R/alphabeta_window_classif.R b/R/alphabeta_window_classif.R
@@ -14,7 +14,7 @@
 #' @export
 
 alphabeta_window_classif <- function(SSwindow, nb_clusters,
-                                     Beta_info, alpha_metrics,
+                                     Beta_info = NULL, alpha_metrics,
                                      pcelim = 0.02,
                                      Hill_order = 1){
   # get spectral species distribution from individual pixels within a window
@@ -27,20 +27,24 @@ alphabeta_window_classif <- function(SSwindow, nb_clusters,
                   nb_pix_sunlit = nb_pix_sunlit,
                   pcelim = pcelim,
                   hill_order = Hill_order)
-  # get BETA diversity
-  # full spectral species distribution = missing clusters set to 0
-  ssd_full <- lapply(X = ssd, FUN = get_normalized_ssd,
-                     nb_clusters = nb_clusters, pcelim = pcelim)
-  mat_bc <- list()
-  pcoa_bc <- list()
-  for (i in seq_along(ssd_full)){
-    mat_bc_tmp <- dissUtils::diss(ssd_full[[i]], Beta_info$SSD,
-                                  method = 'braycurtis')
-    # mat_bc <- list('mat1' = ssd_full[[i]],
-    #                'mat2' = Beta_info$SSD)
-    # mat_bc_tmp <- compute_bc_diss(ssd_list = mat_bc, pcelim = pcelim)
-    pcoa_bc[[i]] <- compute_nn_from_ordination(mat_bc = mat_bc_tmp, knn = 3,
-                                               pcoa_train = Beta_info$BetaPCO$points)
+
+  pcoa_bc <- NULL
+  if (!is.null(Beta_info)){
+    # get BETA diversity
+    # full spectral species distribution = missing clusters set to 0
+    ssd_full <- lapply(X = ssd, FUN = get_normalized_ssd,
+                       nb_clusters = nb_clusters, pcelim = pcelim)
+    mat_bc <- list()
+    pcoa_bc <- list()
+    for (i in seq_along(ssd_full)){
+      mat_bc_tmp <- dissUtils::diss(ssd_full[[i]], Beta_info$SSD,
+                                    method = 'braycurtis')
+      # mat_bc <- list('mat1' = ssd_full[[i]],
+      #                'mat2' = Beta_info$SSD)
+      # mat_bc_tmp <- compute_bc_diss(ssd_list = mat_bc, pcelim = pcelim)
+      pcoa_bc[[i]] <- compute_nn_from_ordination(mat_bc = mat_bc_tmp, knn = 3,
+                                                 pcoa_train = Beta_info$BetaPCO$points)
+    }
   }
   return(list('richness' = unlist(lapply(alpha, '[[', 'richness')),
               'shannon' = unlist(lapply(alpha, '[[', 'shannon')),
diff --git a/R/biodivMapR_SFS.R b/R/biodivMapR_SFS.R
@@ -39,12 +39,12 @@ biodivMapR_sfs <- function(input_raster, obs_vect, obs2optimize,
                            pcelim = 0.02, verbose = TRUE, nbWorkers = 1,
                            nbCPU = 1){
 
-  FullListIndices <- c("richness", "shannon", "simpson", "hill", "BC",
-                       "FRic", "FEve", "FDiv")
+  FullListIndices <- c('richness', 'shannon', 'simpson', 'hill', 'BC',
+                       'FRic', 'FEve', 'FDiv', 'FDis', 'FRaoq')
   #### Which diversity metrics should be computed?
   alphamet <- c('richness', 'shannon', 'simpson', 'hill')
   betamet <- 'BC'
-  fmet <- c('FRic', 'FEve', 'FDiv')
+  fmet <- c('FRic', 'FEve', 'FDiv', 'FDis', 'FRaoq')
   # if computation of functional metrics required
   alpha_metrics <- alphamet[which(alphamet %in% names(obs2optimize))]
   if (length(alpha_metrics)==0)
@@ -133,7 +133,7 @@ biodivMapR_sfs <- function(input_raster, obs_vect, obs2optimize,
   registerDoFuture()
   # plan(multisession, workers = nbWorkers)
   cl <- parallel::makeCluster(nbWorkers)
-  with(plan("cluster", workers = cl), local = TRUE)	
+  with(plan('cluster', workers = cl), local = TRUE)
 
   Corr_criterion <- EvolCorr <-   CorrSFS <- AssessSFS <- list()
   SelectedVars <- EvolCorr$richness <- EvolCorr$shannon <- EvolCorr$simpson <-
@@ -146,7 +146,7 @@ biodivMapR_sfs <- function(input_raster, obs_vect, obs2optimize,
     p <- progressr::progressor(steps = nb_pcs_to_keep)
 
   # pb <- progress::progress_bar$new(
-  #   format = "Perform feature selection [:bar] :percent in :elapsedfull",
+  #   format = 'Perform feature selection [:bar] :percent in :elapsedfull',
   #   total = nb_pcs_to_keep, clear = FALSE, width= 100)
 
     for (nbvars2select in seq_len(nb_pcs_to_keep)){
@@ -169,7 +169,7 @@ biodivMapR_sfs <- function(input_raster, obs_vect, obs2optimize,
             inputdata_cr$ID <- IDplot
             inputdata_cr <- inputdata_cr %>% split(.$ID)
             inputdata_cr <- lapply(inputdata_cr,
-                                   function(x) data.frame(x[ , !(names(x) %in% "ID")]))
+                                   function(x) data.frame(x[ , !(names(x) %in% 'ID')]))
             FunctDiv <- lapply(X = inputdata_cr,
                                FUN = get_functional_diversity,
                                fd_metrics = fd_metrics)
@@ -256,7 +256,7 @@ biodivMapR_sfs <- function(input_raster, obs_vect, obs2optimize,
         }
       }
       subSFS <- subfeatures_SFS()
-      p(message = sprintf("Perform feature selection %g", nbvars2select))
+      p(message = sprintf('Perform feature selection %g', nbvars2select))
       # pb$tick()
       CorrSFS[[nbvars2select]] <- list()
       for (ind in FullListIndices)
diff --git a/R/biodivMapR_full_classif.R b/R/biodivMapR_full_classif.R
@@ -6,6 +6,7 @@
 #' @param input_mask_path character. path for mask file
 #' @param site_name character. nname of site
 #' @param pcelim numeric. minimum proportion of pixels to consider spectral species
+#' @param compute_beta boolean. set TRUE if beta is to be computed
 #' @param nb_samples_beta numeric. number of samples to compute beta diversity
 #'
 #' @return diversity_maps_ground
@@ -14,7 +15,8 @@
 
 biodivMapR_full_classif <- function(input_raster_path, output_dir, window_size,
                                     input_mask_path = NULL, site_name = NULL,
-                                    pcelim = 0.02, nb_samples_beta = 1000){
+                                    pcelim = 0.02, compute_beta = TRUE,
+                                    nb_samples_beta = 1000){
 
   # define all alpha metrics
   alpha_metrics <- c('richness', 'shannon', 'simpson', 'hill')
@@ -32,35 +34,41 @@ biodivMapR_full_classif <- function(input_raster_path, output_dir, window_size,
     input_mask <- terra::rast(input_mask_path)
 
   # define plot selection for beta diversity and sample from raster
-  plots_beta <- plots[sample(x = seq_along(plots), nb_samples_beta,
-                             replace = FALSE)]
-  get_samples_from_plots <- function(x, y){
-    x <- terra::vect(x)
-    res <- terra::extract(x = y, y = x, raw = TRUE, ID = FALSE)
-    res <- c(unlist(res))
-    return(res)
-  }
-  samples <- lapply(X = plots_beta, FUN = get_samples_from_plots,
-                    y = terra::rast(input_raster_path))
+  Beta_info <- NULL
+  if (compute_beta){
+    if (nb_samples_beta > length(plots))
+      nb_samples_beta <- length(plots)
+
+    plots_beta <- plots[sample(x = seq_along(plots), nb_samples_beta,
+                               replace = FALSE)]
+    get_samples_from_plots <- function(x, y){
+      x <- terra::vect(x)
+      res <- terra::extract(x = y, y = x, raw = TRUE, ID = FALSE)
+      res <- c(unlist(res))
+      return(res)
+    }
+    samples <- lapply(X = plots_beta, FUN = get_samples_from_plots,
+                      y = terra::rast(input_raster_path))
 
-  # compute spectral dissimilarity
-  ssd <- lapply(X = samples,FUN = table)
-  ssd <- lapply(X = ssd,FUN = get_normalized_ssd,
-                nb_clusters = nb_clusters, pcelim = pcelim)
-  ssd <- do.call(rbind,ssd)
-  mat_bc <- dissUtils::diss(ssd, ssd, method = 'braycurtis')
-  # ssd_list <- list(ssd, ssd)
-  # mat_bc <- compute_bc_diss(ssd_list, pcelim)
-  Beta_info <- list('SSD' = ssd, 'MatBC' = mat_bc)
-  mat_bc_dist <- stats::as.dist(mat_bc, diag = FALSE, upper = FALSE)
-  BetaPCO <- pco(mat_bc_dist, k = 3)
-  Beta_info <- list('SSD' = ssd,
-                    'MatBC' = mat_bc,
-                    'BetaPCO' = BetaPCO)
-  # # save spectral dissimilarity
-  # if (is.null(Beta_info_save))
-  #   Beta_info_save <- file.path(output_dir, 'Beta_info_classif.RData')
-  # save(Beta_info, file = Beta_info_save)
+    # compute spectral dissimilarity
+    ssd <- lapply(X = samples,FUN = table)
+    ssd <- lapply(X = ssd,FUN = get_normalized_ssd,
+                  nb_clusters = nb_clusters, pcelim = pcelim)
+    ssd <- do.call(rbind,ssd)
+    mat_bc <- dissUtils::diss(ssd, ssd, method = 'braycurtis')
+    # ssd_list <- list(ssd, ssd)
+    # mat_bc <- compute_bc_diss(ssd_list, pcelim)
+    Beta_info <- list('SSD' = ssd, 'MatBC' = mat_bc)
+    mat_bc_dist <- stats::as.dist(mat_bc, diag = FALSE, upper = FALSE)
+    BetaPCO <- pco(mat_bc_dist, k = 3)
+    Beta_info <- list('SSD' = ssd,
+                      'MatBC' = mat_bc,
+                      'BetaPCO' = BetaPCO)
+    # # save spectral dissimilarity
+    # if (is.null(Beta_info_save))
+    #   Beta_info_save <- file.path(output_dir, 'Beta_info_classif.RData')
+    # save(Beta_info, file = Beta_info_save)
+  }
 
   # compute alpha and beta diversity over the full image
   input_rast_tmp <- input_rast
@@ -91,7 +99,7 @@ biodivMapR_full_classif <- function(input_raster_path, output_dir, window_size,
   # save diversity maps
   diversity_maps_ground <- list()
   for (idx in names(alphabeta)){
-    if (idx == 'PCoA_BC'){
+    if (idx == 'PCoA_BC' & !is.null(Beta_info)){
       beta <- list(output_rast_tmp, output_rast_tmp, output_rast_tmp)
       for (i in 1:3)
         beta[[i]][cell_order] <- unlist(lapply(alphabeta[[idx]], '[[', i))
diff --git a/R/biodivMapR_tiles.R b/R/biodivMapR_tiles.R
@@ -108,7 +108,7 @@ biodivMapR_tiles <- function(feature_dir, list_features, mask_dir = NULL,
       } else if (biodividx %in% alpha_metrics){
         selfiles <- list.files(path = output_dir, pattern = biodividx)
         selfiles <- selfiles[grepl(x = basename(selfiles),
-                                   pattern = "mean.tiff")]
+                                   pattern = "mean\\.tiff")]
       }
       selfiles <- file.path(output_dir, selfiles)
       # create directory
diff --git a/R/get_plots_from_tiles.R b/R/get_plots_from_tiles.R
@@ -28,7 +28,7 @@ get_plots_from_tiles <- function(plotID, plots2sel, listfiles, feat_list,
       for (feat in feat_list){
         feat2 <- feat
         if (!feat == 'mask')
-          feat2 <- paste0('_',feat, '.')
+          feat2 <- paste0('_',feat, '\\.')
         # whichfeat <- which(stringr::str_detect(basename(terra::sources(rastID)), feat) )
         whichfeat <- which(grepl(x = basename(terra::sources(rastID)),
                                  pattern = feat2))
diff --git a/R/get_samples_from_tiles.R b/R/get_samples_from_tiles.R
@@ -29,7 +29,7 @@ get_samples_from_tiles <- function(plotID, pix2sel, listfiles, feat_list,
       for (feat in feat_list){
         feat2 <- feat
         if (!feat == 'mask')
-          feat2 <- paste0('_',feat, '.')
+          feat2 <- paste0('_',feat, '\\.')
         whichfeat <- which(grepl(x = basename(terra::sources(rastID)),
                                  pattern = feat2))
         names(rastID)[whichfeat] <- feat
diff --git a/R/radiometric_filtering.R b/R/radiometric_filtering.R
@@ -39,7 +39,7 @@ radiometric_filtering <- function(input_raster_path, output_dir, input_rast_wl,
   }
   mask_update <- file.path(output_dir, maskfilename)
   dir.create(path = output_dir,recursive = TRUE, showWarnings = FALSE)
-  if (filetype%in%c('GTiff', 'COG') & ! grepl(x = mask_update, pattern = '.tiff'))
+  if (filetype%in%c('GTiff', 'COG') & ! grepl(x = mask_update, pattern = '\\.tiff'))
     mask_update <- paste0(mask_update, '.tiff')
 
   # wavelengths expected to perform filtering
diff --git a/R/read_ENVI_header.R b/R/read_ENVI_header.R
@@ -7,7 +7,7 @@
 
 read_ENVI_header <- function(HDRpath) {
   # header <- paste(header, collapse = "\n")
-  if (!grepl(".hdr$", HDRpath) & !grepl(".HDR$", HDRpath))
+  if (!grepl("\\.hdr$", HDRpath) & !grepl("\\.HDR$", HDRpath))
     stop("File extension should be .hdr or .HDR")
 
   HDR <- readLines(HDRpath)
diff --git a/TODO.md b/TODO.md
diff --git a/man/alphabeta_window_classif.Rd b/man/alphabeta_window_classif.Rd
diff --git a/man/biodivMapR_full_classif.Rd b/man/biodivMapR_full_classif.Rd
diff --git a/man/biodivMapR_sfs.Rd b/man/biodivMapR_sfs.Rd

Original file line number	Diff line number	Diff line change
`@@ -108,7 +108,7 @@ biodivMapR_tiles <- function(feature_dir, list_features, mask_dir = NULL,`
`108`	`108`	`} else if (biodividx %in% alpha_metrics){`
`109`	`109`	`selfiles <- list.files(path = output_dir, pattern = biodividx)`
`110`	`110`	`selfiles <- selfiles[grepl(x = basename(selfiles),`
`111`		`- pattern = "mean.tiff")]`
	`111`	`+ pattern = "mean\\.tiff")]`
`112`	`112`	`}`
`113`	`113`	`selfiles <- file.path(output_dir, selfiles)`
`114`	`114`	`# create directory`
Original file line number	Diff line number	Diff line change
`@@ -39,7 +39,7 @@ radiometric_filtering <- function(input_raster_path, output_dir, input_rast_wl,`
`39`	`39`	`}`
`40`	`40`	`mask_update <- file.path(output_dir, maskfilename)`
`41`	`41`	`dir.create(path = output_dir,recursive = TRUE, showWarnings = FALSE)`
`42`		`- if (filetype%in%c('GTiff', 'COG') & ! grepl(x = mask_update, pattern = '.tiff'))`
	`42`	`+ if (filetype%in%c('GTiff', 'COG') & ! grepl(x = mask_update, pattern = '\\.tiff'))`
`43`	`43`	`mask_update <- paste0(mask_update, '.tiff')`
`44`	`44`
`45`	`45`	`# wavelengths expected to perform filtering`