Skip to content

Commit 54ecbef

Browse files
jbferetjbferet
committed
# biodivMapR2 v2.3.16
## addition - add option moving_window for biodivMapR_full
1 parent f6fb9cf commit 54ecbef

12 files changed

+160
-67
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: biodivMapR
22
Title: biodivMapR: an R package for a- and ß-diversity mapping using remotely-sensed images
3-
Version: 2.3.15
3+
Version: 2.3.16
44
Authors@R: c(person(given = "Jean-Baptiste",
55
family = "Feret",
66
email = "jb.feret@teledetection.fr",

‎NEWS.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
# biodivMapR2 v2.3.16
2+
## addition
3+
- add option moving_window for biodivMapR_full
4+
15
# biodivMapR2 v2.3.15
26
## change
37
- add options as input parameter for 'biodivMapR_full_tiles' in order to reduce nb of inputs

‎R/biodivMapR_full.R‎

Lines changed: 64 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@
2323
#' @param dimPCoA numeric. number of dimensions of PCoA
2424
#' @param progressbar boolean. set true for progress bar during clustering
2525
#' @param filetype character. driver for output diversity raster data
26+
#' @param moving_window boolean. should diversity be computed on moving window?
2627
#'
2728
#' @return Kmeans_info and Beta_info
2829
#' @export
@@ -36,7 +37,8 @@ biodivMapR_full <- function(input_raster_path, output_dir, window_size,
3637
Hill_order = 1, FDmetric = NULL, pcelim = 0.02,
3738
nbCPU = 1, nb_iter = 10, min_sun = 0.25,
3839
nb_samples_alpha = 1e5, dimPCoA = 3,
39-
progressbar = TRUE, filetype = 'GTiff'){
40+
progressbar = TRUE, filetype = 'GTiff',
41+
moving_window = FALSE){
4042

4143
dir.create(output_dir, showWarnings = FALSE, recursive = TRUE)
4244
# read input rasters
@@ -80,28 +82,67 @@ biodivMapR_full <- function(input_raster_path, output_dir, window_size,
8082
# input_rasters <- list('main' = input_raster_path,
8183
# 'mask' = input_mask_path)
8284
options(fundiversity.memoise = FALSE)
83-
ab_div_metrics <- get_raster_diversity(input_raster_path = input_raster_path,
84-
input_mask_path = input_mask_path,
85-
Kmeans_info = Kmeans_info,
86-
Beta_info = Beta_info,
87-
selected_bands = selected_bands,
88-
window_size = window_size,
89-
alphametrics = alphametrics,
90-
Hill_order = Hill_order,
91-
FDmetric = FDmetric,
92-
pcelim = pcelim,
93-
maxRows = maxRows, nbCPU = nbCPU,
94-
min_sun = min_sun)
9585

96-
# save diversity metrics as raster data
97-
save_diversity_maps(ab_div_metrics = ab_div_metrics,
98-
alphametrics = alphametrics,
99-
Hill_order = Hill_order,
100-
FDmetric = FDmetric,
101-
input_rast = input_rast,
102-
output_dir = output_dir,
103-
window_size = window_size,
104-
filetype = filetype)
105-
return(list('Kmeans_info' = Kmeans_info,
86+
if (!moving_window){
87+
message('compute raster diversity using moving window')
88+
message('please set "moving_window = FALSE" if this takes too much time')
89+
ab_div_metrics <- get_raster_diversity(input_raster_path = input_raster_path,
90+
input_mask_path = input_mask_path,
91+
Kmeans_info = Kmeans_info,
92+
Beta_info = Beta_info,
93+
selected_bands = selected_bands,
94+
window_size = window_size,
95+
alphametrics = alphametrics,
96+
Hill_order = Hill_order,
97+
FDmetric = FDmetric,
98+
pcelim = pcelim,
99+
maxRows = maxRows, nbCPU = nbCPU,
100+
min_sun = min_sun)
101+
102+
# save diversity metrics as raster data
103+
diversity_maps <- save_diversity_maps(ab_div_metrics = ab_div_metrics,
104+
alphametrics = alphametrics,
105+
Hill_order = Hill_order,
106+
FDmetric = FDmetric,
107+
input_rast = input_rast,
108+
output_dir = output_dir,
109+
window_size = window_size,
110+
filetype = filetype)
111+
}
112+
113+
if (moving_window){
114+
ab_div_metrics <- get_raster_diversity_mw(input_raster_path = input_raster_path,
115+
input_mask_path = input_mask_path,
116+
Kmeans_info = Kmeans_info,
117+
Beta_info = Beta_info,
118+
selected_bands = selected_bands,
119+
window_size = window_size,
120+
alphametrics = alphametrics,
121+
Hill_order = Hill_order,
122+
FDmetric = FDmetric,
123+
pcelim = pcelim,
124+
maxRows = maxRows, nbCPU = nbCPU,
125+
min_sun = min_sun)
126+
127+
betanames <- 'beta_mw'
128+
alphanames <- paste0(alphametrics,'_mw')
129+
functionalname <- NULL
130+
if (!is.null(FDmetric))
131+
functionalname <- paste0(FDmetric,'_mw')
132+
output_raster_name <- as.list(c(betanames, alphanames, functionalname))
133+
names(output_raster_name) <- c('beta', alphametrics, FDmetric)
134+
diversity_maps <- save_diversity_maps_mw(input_raster_path = input_raster_path,
135+
ab_div_metrics = ab_div_metrics,
136+
alphametrics = alphametrics,
137+
Hill_order = Hill_order,
138+
FDmetric = FDmetric,
139+
input_rast = input_rast,
140+
output_dir = output_dir,
141+
output_raster_name = output_raster_name,
142+
window_size = window_size,
143+
filetype = filetype)
144+
}
145+
return(list('diversity_maps' = diversity_maps,
146+
'Kmeans_info' = Kmeans_info,
106147
'Beta_info' = Beta_info))
107148
}

‎R/biodivMapR_full_classif.R‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -133,14 +133,15 @@ biodivMapR_full_classif <- function(input_raster_path, output_dir, window_size,
133133

134134

135135
# save diversity metrics as raster data
136-
save_diversity_maps(ab_div_metrics = ab_div_metrics,
137-
alphametrics = alphametrics,
138-
Hill_order = Hill_order,
139-
FDmetric = FDmetric,
140-
input_rast = input_rast,
141-
output_dir = output_dir,
142-
window_size = window_size,
143-
filetype = filetype)
144-
return(list('Kmeans_info' = Kmeans_info,
136+
diversity_maps <- save_diversity_maps(ab_div_metrics = ab_div_metrics,
137+
alphametrics = alphametrics,
138+
Hill_order = Hill_order,
139+
FDmetric = FDmetric,
140+
input_rast = input_rast,
141+
output_dir = output_dir,
142+
window_size = window_size,
143+
filetype = filetype)
144+
return(list('diversity_maps' = diversity_maps,
145+
'Kmeans_info' = Kmeans_info,
145146
'Beta_info' = Beta_info))
146147
}

‎R/get_raster_diversity.R‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,8 @@ get_raster_diversity <- function(input_raster_path, Kmeans_info, Beta_info,
2525
alphametrics = 'shannon', Hill_order = 1,
2626
FDmetric = NULL, window_size, maxRows = NULL,
2727
pcelim = 0.02, nbCPU = 1, min_sun = 0.25){
28+
29+
message('compute raster diversity')
2830
if (is.null(maxRows))
2931
maxRows <- 20*window_size
3032
# prepare to read input raster data

‎R/mosaic_tiles.R‎

Lines changed: 15 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -18,16 +18,24 @@ mosaic_tiles <- function(pattern, dir_path, vrt_save, siteName = NULL,
1818
siteName <- paste0('_', siteName, '_')
1919
listfiles <- list.files(dir_path, pattern = pattern, full.names = TRUE)
2020
output_vrt_path <- file.path(getwd(), paste0(siteName, pattern,'_mosaic.vrt'))
21-
if (!file.exists(output_vrt_path))
22-
v <- terra::vrt(x = listfiles, filename = output_vrt_path)
21+
# if (!file.exists(output_vrt_path))
22+
v <- terra::vrt(x = listfiles, filename = output_vrt_path, overwrite = TRUE)
2323

2424
# create tiff from vrt
2525
mosaic_path <- file.path(dir_path, paste0(siteName, pattern,'_mosaic.tiff'))
26-
if (!file.exists(mosaic_path) | overwrite)
27-
sf::gdal_utils(util = 'translate', source = output_vrt_path,
28-
destination = mosaic_path,
29-
options = c("COMPRESS=LZW", "BIGTIFF=IF_SAFER"))
30-
# co = c("COMPRESS=LZW", "BIGTIFF=IF_SAFER"))
26+
if (!file.exists(mosaic_path) | overwrite){
27+
if (dim(v)[[1]]*dim(v)[[2]]*5 < 1e8){
28+
message(paste('write image for diversity metric', pattern))
29+
sf::gdal_utils(util = 'translate', source = output_vrt_path,
30+
destination = mosaic_path)
31+
} else {
32+
message(paste('write compressed image for diversity metric', pattern))
33+
sf::gdal_utils(util = 'translate', source = output_vrt_path,
34+
destination = mosaic_path,
35+
options = c("COMPRESS=LZW", "BIGTIFF=IF_SAFER"))
36+
# co = c("COMPRESS=LZW", "BIGTIFF=IF_SAFER"))
37+
}
38+
}
3139

3240
# delete vrt
3341
file.remove(output_vrt_path)

‎R/run_biodivMapR.R‎

Lines changed: 20 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -52,16 +52,16 @@ run_biodivMapR <- function(input_raster_path, input_mask_path = NULL,
5252
nbCPU = nbCPU,
5353
min_sun = min_sun)
5454
# save diversity metrics as raster data
55-
save_diversity_maps_tile(input_raster_path = input_raster_path,
56-
ab_div_metrics = ab_div_metrics,
57-
alphametrics = alphametrics,
58-
Hill_order = Hill_order,
59-
FDmetric = FDmetric,
60-
input_rast = input_rast,
61-
output_dir = output_dir,
62-
output_raster_name = output_raster_name,
63-
window_size = window_size,
64-
filetype = filetype)
55+
diversity_maps <- save_diversity_maps_tile(input_raster_path = input_raster_path,
56+
ab_div_metrics = ab_div_metrics,
57+
alphametrics = alphametrics,
58+
Hill_order = Hill_order,
59+
FDmetric = FDmetric,
60+
input_rast = input_rast,
61+
output_dir = output_dir,
62+
output_raster_name = output_raster_name,
63+
window_size = window_size,
64+
filetype = filetype)
6565
}
6666
if (moving_window){
6767
ab_div_metrics <- get_raster_diversity_mw(input_raster_path = input_raster_path,
@@ -77,16 +77,16 @@ run_biodivMapR <- function(input_raster_path, input_mask_path = NULL,
7777
maxRows = maxRows, nbCPU = nbCPU,
7878
min_sun = min_sun)
7979

80-
save_diversity_maps_mw(input_raster_path = input_raster_path,
81-
ab_div_metrics = ab_div_metrics,
82-
alphametrics = alphametrics,
83-
Hill_order = Hill_order,
84-
FDmetric = FDmetric,
85-
input_rast = input_rast,
86-
output_dir = output_dir,
87-
output_raster_name = output_raster_name,
88-
window_size = window_size,
89-
filetype = filetype)
80+
diversity_maps <- save_diversity_maps_mw(input_raster_path = input_raster_path,
81+
ab_div_metrics = ab_div_metrics,
82+
alphametrics = alphametrics,
83+
Hill_order = Hill_order,
84+
FDmetric = FDmetric,
85+
input_rast = input_rast,
86+
output_dir = output_dir,
87+
output_raster_name = output_raster_name,
88+
window_size = window_size,
89+
filetype = filetype)
9090
}
9191
return()
9292
}

‎R/run_biodivMapR_plot.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,8 @@ run_biodivMapR_plot <- function(id, feature_dir, mask_dir = NULL,
4040
functionalname <- paste0(FDmetric,'_',id)
4141
alphanames_mean <- paste0(alphanames,'_mean')
4242
output_raster_name <- as.list(c(betanames, alphanames, functionalname))
43-
output_raster_name_mean <- as.list(c(betanames, alphanames_mean, functionalname))
43+
output_raster_name_mean <- as.list(c(betanames, alphanames_mean,
44+
functionalname))
4445
names(output_raster_name) <- c('beta', alphametrics, FDmetric)
4546
if (FALSE %in% file.exists(file.path(output_dir,
4647
paste0(output_raster_name_mean,'.tiff')))){

‎R/save_diversity_maps.R‎

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,10 +23,13 @@ save_diversity_maps <- function(ab_div_metrics,
2323
output_raster_name = NULL,
2424
window_size,
2525
filetype = 'GTiff'){
26+
27+
diversity_maps <- list()
2628
# save alpha diversity indices
2729
for (idx in alphametrics) {
2830
idx2 <- idx
29-
if (idx == 'hill') idx2 <- paste0(idx, '_', Hill_order)
31+
if (idx == 'hill')
32+
idx2 <- paste0(idx, '_', Hill_order)
3033
# Mean value
3134
# produce a template
3235
template_rast <- terra::aggregate(input_rast[[1]], fact = window_size)
@@ -48,6 +51,9 @@ save_diversity_maps <- function(ab_div_metrics,
4851
terra::writeRaster(x = template_rast, filename = output_raster,
4952
filetype = filetype, overwrite = TRUE,
5053
gdal = c("COMPRESS=LZW"))
54+
55+
diversity_maps[[paste0(idx2, '_mean')]] <- output_raster
56+
5157
# SD value
5258
# produce a template
5359
template_rast <- terra::aggregate(input_rast[[1]], fact = window_size)
@@ -67,6 +73,7 @@ save_diversity_maps <- function(ab_div_metrics,
6773
terra::writeRaster(x = template_rast, filename = output_raster,
6874
filetype = filetype, overwrite = TRUE,
6975
gdal = c("COMPRESS=LZW"))
76+
diversity_maps[[paste0(idx2, '_sd')]] <- output_raster
7077
}
7178

7279
# save functional diversity indices
@@ -87,6 +94,7 @@ save_diversity_maps <- function(ab_div_metrics,
8794
terra::writeRaster(x = template_rast, filename = output_raster,
8895
filetype = filetype, overwrite = TRUE,
8996
gdal = c("COMPRESS=LZW"))
97+
diversity_maps[[idx]] <- output_raster
9098
}
9199

92100
# save beta diversity indices
@@ -113,5 +121,7 @@ save_diversity_maps <- function(ab_div_metrics,
113121
terra::writeRaster(x = template_rast, filename = output_raster,
114122
filetype = filetype, overwrite = TRUE,
115123
gdal = c("COMPRESS=LZW"))
116-
return(invisible())
124+
diversity_maps[['beta']] <- output_raster
125+
126+
return(diversity_maps)
117127
}

‎R/save_diversity_maps_mw.R‎

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -37,9 +37,11 @@ save_diversity_maps_mw <- function(input_raster_path,
3737
# }
3838
# }
3939

40+
diversity_maps <- list()
4041
for (idx in alphametrics) {
4142
idx2 <- idx
42-
if (idx == 'hill') idx2 <- paste0(idx, '_', Hill_order)
43+
if (idx == 'hill')
44+
idx2 <- paste0(idx, '_', Hill_order)
4345
# Mean value
4446
# produce a template
4547
template_rast <- terra::rast(input_raster_path[[1]])
@@ -57,6 +59,7 @@ save_diversity_maps_mw <- function(input_raster_path,
5759
terra::writeRaster(x = template_rast, filename = output_raster,
5860
filetype = filetype, overwrite = TRUE,
5961
gdal = c("COMPRESS=LZW"))
62+
diversity_maps[[paste0(idx2, '_mean')]] <- output_raster
6063
# SD value
6164
# produce a template
6265
template_rast <- terra::rast(input_raster_path[[1]])
@@ -73,6 +76,7 @@ save_diversity_maps_mw <- function(input_raster_path,
7376
terra::writeRaster(x = template_rast, filename = output_raster,
7477
filetype = filetype, overwrite = TRUE,
7578
gdal = c("COMPRESS=LZW"))
79+
diversity_maps[[paste0(idx2, '_sd')]] <- output_raster
7680
}
7781

7882
# save functional diversity indices
@@ -86,10 +90,12 @@ save_diversity_maps_mw <- function(input_raster_path,
8690
output_raster <- file.path(output_dir, idx)
8791
if (!is.null(output_raster_name[[idx]]))
8892
output_raster <- file.path(output_dir, output_raster_name[[idx]])
89-
if (filetype%in%c('GTiff', 'COG')) output_raster <- paste0(output_raster, '.tiff')
93+
if (filetype%in%c('GTiff', 'COG'))
94+
output_raster <- paste0(output_raster, '.tiff')
9095
terra::writeRaster(x = template_rast, filename = output_raster,
9196
filetype = filetype, overwrite = TRUE,
9297
gdal = c("COMPRESS=LZW"))
98+
diversity_maps[[idx]] <- output_raster
9399
}
94100

95101
# save beta diversity indices
@@ -112,5 +118,6 @@ save_diversity_maps_mw <- function(input_raster_path,
112118
terra::writeRaster(x = template_rast, filename = output_raster,
113119
filetype = filetype, overwrite = TRUE,
114120
gdal = c("COMPRESS=LZW"))
115-
return(invisible())
121+
diversity_maps[['beta']] <- output_raster
122+
return(diversity_maps)
116123
}

0 commit comments

Comments
 (0)