Skip to content

Commit 2e7c154

Browse files
jbferetjbferet
committed
# biodivMapR2 v2.1.4
## fix - in 'get_diversity_from_plots' : - initialize Attributes with nrow = nbPlots_init - initialize functional diversity metrics in Attributes with NA - correct get_diversity_from_plots : assign to beta diversity values instead of mean Hill - correct extract_vect_from_rast : update AttributeTable and discard vectors with no data ## addition - create functions init_kmeans_samples and init_PCoA_samples to process samples previously extracted independently from an input raster - possibility to provide name for output files in addition to directory ## change - possibility to define updated mask file name as input for radiometric_filtering
1 parent 5cb731b commit 2e7c154

13 files changed

+286
-93
lines changed

‎DESCRIPTION

+1-1
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.1.3
3+
Version: 2.1.4
44
Authors@R: c(person(given = "Jean-Baptiste",
55
family = "Feret",
66
email = "jb.feret@teledetection.fr",

‎NEWS.md

+16
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,19 @@
1+
# biodivMapR2 v2.1.4
2+
## fix
3+
- in 'get_diversity_from_plots' :
4+
- initialize Attributes with nrow = nbPlots_init
5+
- initialize functional diversity metrics in Attributes with NA
6+
- correct get_diversity_from_plots : assign to beta diversity values instead of mean Hill
7+
- correct extract_vect_from_rast : update AttributeTable and discard vectors with no data
8+
9+
## addition
10+
- create functions init_kmeans_samples and init_PCoA_samples to process samples
11+
previously extracted independently from an input raster
12+
- possibility to provide name for output files in addition to directory
13+
14+
## change
15+
- possibility to define updated mask file name as input for radiometric_filtering
16+
117
# biodivMapR2 v2.1.3
218
## fix
319
- correct get_diversity_from_plots: output for FDis corrected to FDis instead of FDiv

‎R/biodivMapR_chunk.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,7 @@ biodivMapR_chunk <- function(blk, r_in, window_size, Kmeans_info, Beta_info = NU
5353
nbWindows <- max(inputdata$win_ID)
5454
# 2a- eliminate masked pixels
5555
if ('mask' %in% names(inputdata)){
56-
inputdata <- inputdata %>% dplyr::filter(inputdata$mask == 1)
56+
inputdata <- inputdata %>% dplyr::filter(inputdata$mask > 0)
5757
inputdata$mask <- NULL
5858
}
5959
# 2b- eliminate NA and inf

‎R/extract_vect_from_rast.R

+2
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,8 @@ extract_vect_from_rast <- function(SpatVector, input_rast,
3131
rast_sample <- rast_sample[sel,]
3232
}
3333
rast_sample <- clean_NAsInf(rast_sample)
34+
# update attribute table to eliminate plots which include no information
35+
AttributeTable <- AttributeTable[unique(rast_sample$ID),]
3436
# get plot size
3537
nbPix_per_plot <- data.frame(table(rast_sample$ID))
3638
# only get common plots between nbPix_per_plot and nbPix_per_plot_init

‎R/get_diversity_from_plots.R

+21-11
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@
1818
#' @param verbose boolean. set true for messages
1919
#'
2020
#' @return SpatVector including diversity metrics and BC dissimilarity for the plots
21+
#' @importFrom dplyr group_split
2122
#' @export
2223

2324
get_diversity_from_plots <- function(input_rast, validation_vect,
@@ -86,12 +87,20 @@ get_diversity_from_plots <- function(input_rast, validation_vect,
8687
AttributeTable = AttributeTable,
8788
MinSun = MinSun)
8889
SSValid <- ssvect$SSValid
89-
Attributes <- ssvect$AttributeTable
9090
if (inherits(validation_vect, what = 'SpatVector')) {
9191
nbPlots_init <- length(validation_vect)
92+
nbPlots <- nrow(ssvect$AttributeTable)
93+
selPlots <- ssvect$AttributeTable$ID_biodivMapR
9294
} else if (!is.null(rast_sample)) {
93-
nbPlots_init <- length(unique(rast_sample$ID))
95+
nbPlots_init <- nbPlots <- length(unique(rast_sample$ID))
96+
selPlots <- seq_len(nbPlots_init)
9497
}
98+
Attributes0 <- ssvect$AttributeTable
99+
Attributes <- data.frame(matrix(NA, ncol = ncol(ssvect$AttributeTable),
100+
# nrow = nrow(ssvect$AttributeTable)))
101+
nrow = nbPlots_init))
102+
names(Attributes) <- names(Attributes0)
103+
Attributes[selPlots,] <- Attributes0
95104
FunctDiv <- data.frame('FRic' = ssvect$FunctDiv$FRic,
96105
'FEve' = ssvect$FunctDiv$FEve,
97106
'FDiv' = ssvect$FunctDiv$FDiv,
@@ -133,7 +142,7 @@ get_diversity_from_plots <- function(input_rast, validation_vect,
133142
Attributes$hill_sd <- res_shapeChunk[[10]]
134143
# 8- reshape beta diversity metrics
135144
if (!is.null(Beta_info)){
136-
PCoA_BC0 <- do.call(rbind,lapply(alphabetaIdx,'[[',9))
145+
PCoA_BC0 <- do.call(rbind,lapply(alphabetaIdx,'[[',11))
137146
PCoA_BC <- matrix(data = NA,nrow = nbPlots_init, ncol = dimPCO)
138147
PCoA_BC[IDwindow,] <- PCoA_BC0
139148
Attributes$BetaFull_PCoA_1 <- PCoA_BC[,1]
@@ -168,14 +177,15 @@ get_diversity_from_plots <- function(input_rast, validation_vect,
168177
Attributes$BetaPlots_PCoA_3 <- PCoA_BC[,3]
169178
}
170179
if (!is.null(Functional)) {
171-
FunctDiv$ID_biodivMapR <- Attributes$ID_biodivMapR
172-
FunctDiv$id <- Attributes$id
173-
FunctDiv$source <- Attributes$source
174-
Attributes$FRic <- FunctDiv$FRic
175-
Attributes$FEve <- FunctDiv$FEve
176-
Attributes$FDiv <- FunctDiv$FDiv
177-
Attributes$FDis <- FunctDiv$FDis
178-
Attributes$FRaoq <- FunctDiv$FRaoq
180+
# FunctDiv$ID_biodivMapR <- Attributes$ID_biodivMapR
181+
# FunctDiv$id <- Attributes$id
182+
# FunctDiv$source <- Attributes$source
183+
Attributes$FRic <- Attributes$FEve <- Attributes$FDiv <- Attributes$FDis <- Attributes$FRaoq <- NA
184+
Attributes$FRic[selPlots] <- FunctDiv$FRic
185+
Attributes$FEve[selPlots] <- FunctDiv$FEve
186+
Attributes$FDiv[selPlots] <- FunctDiv$FDiv
187+
Attributes$FDis[selPlots] <- FunctDiv$FDis
188+
Attributes$FRaoq[selPlots] <- FunctDiv$FRaoq
179189
}
180190
if (verbose == T) message('diversity computed from vector plot network')
181191
return(list('specdiv' = Attributes,

‎R/get_raster_diversity.R

+27-7
Original file line numberDiff line numberDiff line change
@@ -48,11 +48,9 @@ get_raster_diversity <- function(input_raster_path, Kmeans_info, Beta_info,
4848
nbchunks <- length(blk$row)
4949
for (i in seq_len(nbchunks)) blk_list[[i]] <- list('row'= blk$row[i],
5050
'nrows' = blk$nrows[i])
51-
# compute diversity metrics for each block
52-
handlers(global = TRUE)
53-
handlers("cli")
54-
with_progress({
55-
p <- progressr::progressor(steps = length(blk_list))
51+
52+
if (nbCPU==1){
53+
# compute diversity metrics for each block
5654
ab_div_metrics <- lapply(X = blk_list,
5755
FUN = biodivMapR_chunk,
5856
Kmeans_info = Kmeans_info,
@@ -64,8 +62,30 @@ get_raster_diversity <- function(input_raster_path, Kmeans_info, Beta_info,
6462
window_size = window_size,
6563
SelectBands = SelectBands,
6664
pcelim = pcelim, nbCPU = nbCPU,
67-
MinSun = MinSun, p = p)
68-
})
65+
MinSun = MinSun)
66+
} else {
67+
if (nbCPU>1){
68+
# compute diversity metrics for each block
69+
handlers(global = TRUE)
70+
handlers("cli")
71+
with_progress({
72+
p <- progressr::progressor(steps = length(blk_list))
73+
ab_div_metrics <- lapply(X = blk_list,
74+
FUN = biodivMapR_chunk,
75+
Kmeans_info = Kmeans_info,
76+
Beta_info = Beta_info,
77+
alphametrics = alphametrics,
78+
Hill_order = Hill_order,
79+
FDmetric = FDmetric,
80+
r_in = r_in,
81+
window_size = window_size,
82+
SelectBands = SelectBands,
83+
pcelim = pcelim, nbCPU = nbCPU,
84+
MinSun = MinSun, p = p)
85+
})
86+
}
87+
88+
}
6989
for (fid in names(r_in)) terra::readStop(r_in[[fid]])
7090
return(ab_div_metrics)
7191
}

‎R/init_PCoA.R

+47-42
Original file line numberDiff line numberDiff line change
@@ -33,9 +33,8 @@ init_PCoA <- function(input_rast, output_dir, window_size, Kmeans_info,
3333

3434
# if path for data required to map beta diversity provided
3535
if (!is.null(Beta_info_read)) {
36-
if (file.exists(Beta_info_read)){
37-
load(Beta_info_read)
38-
} else {
36+
if (file.exists(Beta_info_read)) load(Beta_info_read)
37+
if (!file.exists(Beta_info_read)){
3938
print_error_message('Beta_info_file_missing')
4039
Beta_info_read <- NULL
4140
}
@@ -75,46 +74,52 @@ init_PCoA <- function(input_rast, output_dir, window_size, Kmeans_info,
7574
rast_sample2$ID <- rast_sample2$ID + nbSamples
7675
rast_sample <- rbind(rast_sample, rast_sample2)
7776
}
78-
# list per plot
79-
rast_sample <- rast_sample %>% group_split(ID, .keep = F)
80-
if (verbose ==T) message('compute spectral species from beta plots')
81-
# compute spectral species for each plot
82-
ResDist <- lapply(X = rast_sample, FUN = apply_kmeans,
83-
Kmeans_info = Kmeans_info,
84-
SelectBands = SelectBands)
8577

86-
# spectral species distribution
87-
SSdist <- list()
88-
for (iter in names(ResDist[[1]])) SSdist[[iter]] <- lapply(ResDist, '[[',iter)
89-
# get nbIter and nbclusters
90-
nbIter <- length(Kmeans_info$Centroids)
91-
nbclusters <- dim(Kmeans_info$Centroids[[1]])[1]
92-
# compute spectral species distribution for each cluster & BC dissimilarity
93-
if (verbose ==T) message('compute dissimilarity among plots')
94-
# plan(multisession, workers = nbCPU)
95-
cl <- parallel::makeCluster(nbCPU)
96-
plan("cluster", workers = cl)
97-
handlers(global = TRUE)
98-
handlers("cli")
99-
with_progress({
100-
p <- progressr::progressor(steps = nbIter)
101-
Beta_info <- future.apply::future_lapply(SSdist,
102-
FUN = get_BCdiss_from_SSD,
103-
nbclusters = nbclusters,
104-
pcelim = pcelim, p = p)
105-
})
106-
parallel::stopCluster(cl)
107-
plan(sequential)
108-
MatBC_iter <- lapply(Beta_info, '[[','MatBC')
109-
SSD <- lapply(Beta_info, '[[','SSD')
110-
MatBC <- Reduce('+', MatBC_iter)/nbIter
111-
MatBCdist <- stats::as.dist(MatBC, diag = FALSE, upper = FALSE)
112-
BetaPCO <- labdsv::pco(MatBCdist, k = dimPCoA)
113-
# Beta_Ordination_sel <- BetaPCO$points
114-
Beta_info <- list('SSD' = SSD, 'MatBC' = MatBC, 'BetaPCO' = BetaPCO)
115-
if (is.null(Beta_info_save)) Beta_info_save <- file.path(output_dir,
116-
'Beta_info.RData')
117-
save(Beta_info, file = Beta_info_save)
78+
Beta_info <- init_PCoA_samples(rast_sample = rast_sample, output_dir = output_dir,
79+
Kmeans_info = Kmeans_info, SelectBands = SelectBands,
80+
pcelim = pcelim, dimPCoA = dimPCoA, nbCPU = nbCPU,
81+
Beta_info_save = Beta_info_save, verbose = verbose)
82+
83+
# # list per plot
84+
# rast_sample <- rast_sample %>% group_split(ID, .keep = F)
85+
# if (verbose ==T) message('compute spectral species from beta plots')
86+
# # compute spectral species for each plot
87+
# ResDist <- lapply(X = rast_sample, FUN = apply_kmeans,
88+
# Kmeans_info = Kmeans_info,
89+
# SelectBands = SelectBands)
90+
#
91+
# # spectral species distribution
92+
# SSdist <- list()
93+
# for (iter in names(ResDist[[1]])) SSdist[[iter]] <- lapply(ResDist, '[[',iter)
94+
# # get nbIter and nbclusters
95+
# nbIter <- length(Kmeans_info$Centroids)
96+
# nbclusters <- dim(Kmeans_info$Centroids[[1]])[1]
97+
# # compute spectral species distribution for each cluster & BC dissimilarity
98+
# if (verbose ==T) message('compute dissimilarity among plots')
99+
# # plan(multisession, workers = nbCPU)
100+
# cl <- parallel::makeCluster(nbCPU)
101+
# plan("cluster", workers = cl)
102+
# handlers(global = TRUE)
103+
# handlers("cli")
104+
# with_progress({
105+
# p <- progressr::progressor(steps = nbIter)
106+
# Beta_info <- future.apply::future_lapply(SSdist,
107+
# FUN = get_BCdiss_from_SSD,
108+
# nbclusters = nbclusters,
109+
# pcelim = pcelim, p = p)
110+
# })
111+
# parallel::stopCluster(cl)
112+
# plan(sequential)
113+
# MatBC_iter <- lapply(Beta_info, '[[','MatBC')
114+
# SSD <- lapply(Beta_info, '[[','SSD')
115+
# MatBC <- Reduce('+', MatBC_iter)/nbIter
116+
# MatBCdist <- stats::as.dist(MatBC, diag = FALSE, upper = FALSE)
117+
# BetaPCO <- labdsv::pco(MatBCdist, k = dimPCoA)
118+
# # Beta_Ordination_sel <- BetaPCO$points
119+
# Beta_info <- list('SSD' = SSD, 'MatBC' = MatBC, 'BetaPCO' = BetaPCO)
120+
# if (is.null(Beta_info_save)) Beta_info_save <- file.path(output_dir,
121+
# 'Beta_info.RData')
122+
# save(Beta_info, file = Beta_info_save)
118123
}
119124
return(Beta_info)
120125
}

‎R/init_PCoA_samples.R

+77
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,77 @@
1+
#' initialize PCoA for beta diversity mapping based on samples extracted from images
2+
#'
3+
#' @param rast_sample data frame containing samples to use
4+
#' @param output_dir character. Path for output directory
5+
#' @param Kmeans_info list. obtained from prepare_init_kmeans
6+
#' @param SelectBands numeric. bands selected from input_rast
7+
#' @param pcelim numeric. minimum proportion of pixels to consider spectral species
8+
#' @param dimPCoA numeric.
9+
#' @param nbCPU numeric. Number of CPUs available
10+
#' @param Beta_info_save character. path where to save Beta_info
11+
#' @param verbose boolean. set true for messages
12+
#'
13+
#' @return list including spectral species distribution & BC diss matrix per plot, BetaPCO model
14+
#' @import cli
15+
#' @importFrom future plan multisession sequential
16+
#' @importFrom future.apply future_lapply
17+
#' @importFrom progressr progressor handlers with_progress
18+
#' @importFrom labdsv pco
19+
#' @importFrom dplyr group_split
20+
#' @importFrom stats as.dist
21+
#' @importFrom parallel makeCluster stopCluster
22+
#' @export
23+
24+
init_PCoA_samples <- function(rast_sample, output_dir, Kmeans_info,
25+
SelectBands = NULL, pcelim = 0.02, dimPCoA = 3,
26+
nbCPU = 1, Beta_info_save = NULL, verbose = T){
27+
28+
rast_sample <- clean_NAsInf(rast_sample)
29+
# list per plot
30+
rast_sample <- rast_sample %>% group_split(ID, .keep = F)
31+
if (verbose ==T) message('compute spectral species from beta plots')
32+
# compute spectral species for each plot
33+
ResDist <- lapply(X = rast_sample, FUN = apply_kmeans,
34+
Kmeans_info = Kmeans_info,
35+
SelectBands = SelectBands)
36+
37+
# spectral species distribution
38+
SSdist <- list()
39+
for (iter in names(ResDist[[1]])) SSdist[[iter]] <- lapply(ResDist, '[[',iter)
40+
# get nbIter and nbclusters
41+
nbIter <- length(Kmeans_info$Centroids)
42+
nbclusters <- dim(Kmeans_info$Centroids[[1]])[1]
43+
# compute spectral species distribution for each cluster & BC dissimilarity
44+
if (verbose ==T) message('compute dissimilarity among plots')
45+
# plan(multisession, workers = nbCPU)
46+
if (nbCPU>1){
47+
cl <- parallel::makeCluster(nbCPU)
48+
plan("cluster", workers = cl)
49+
handlers(global = TRUE)
50+
handlers("cli")
51+
with_progress({
52+
p <- progressr::progressor(steps = nbIter)
53+
Beta_info <- future.apply::future_lapply(SSdist,
54+
FUN = get_BCdiss_from_SSD,
55+
nbclusters = nbclusters,
56+
pcelim = pcelim, p = p)
57+
})
58+
parallel::stopCluster(cl)
59+
plan(sequential)
60+
} else {
61+
Beta_info <- lapply(X = SSdist,
62+
FUN = get_BCdiss_from_SSD,
63+
nbclusters = nbclusters,
64+
pcelim = pcelim, p = p)
65+
}
66+
MatBC_iter <- lapply(Beta_info, '[[','MatBC')
67+
SSD <- lapply(Beta_info, '[[','SSD')
68+
MatBC <- Reduce('+', MatBC_iter)/nbIter
69+
MatBCdist <- stats::as.dist(MatBC, diag = FALSE, upper = FALSE)
70+
BetaPCO <- labdsv::pco(MatBCdist, k = dimPCoA)
71+
# Beta_Ordination_sel <- BetaPCO$points
72+
Beta_info <- list('SSD' = SSD, 'MatBC' = MatBC, 'BetaPCO' = BetaPCO)
73+
if (is.null(Beta_info_save)) Beta_info_save <- file.path(output_dir,
74+
'Beta_info.RData')
75+
save(Beta_info, file = Beta_info_save)
76+
return(Beta_info)
77+
}

0 commit comments

Comments
 (0)