Commit 40acdaae authored by De Boissieu Florian's avatar De Boissieu Florian

merge with master which had most recent modifications

Merge branch 'master' into CRAN

# Conflicts:
#	DESCRIPTION
#	R/Lib_FilterData.R
#	man/check_data.Rd
#	man/perform_radiometric_filtering.Rd
parents be326cc8 5550ea56
......@@ -3,5 +3,4 @@ doc
.Rproj.user
.Rbuildignore
.Rhistory
RESULTS
02_REDACTION
TODO.md
Package: biodivMapR
Title: biodivMapR: an R package for α- and β-diversity mapping using remotely-sensed images
Version: 0.9.0
Authors@R: c( person("Jean-Baptiste", "Feret", email = "jb.feret@teledetection.fr", role = c("aut", "cre")),
person("Florian", "de Boissieu", email = "florian.deboissieu@irstea.fr", role = c("ctb"), comment = "clean code, format as package"))
Authors@R: c(person(given = "Jean-Baptiste",
family = "Feret",
email = "jb.feret@teledetection.fr",
role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-0151-1334")),
person( given = "Florian",
family = "de Boissieu",
email = "florian.deboissieu@irstea.fr",
role = c("ctb"),
comment = "clean code, format as package"))
Description: Biodiversity estimation from multispectral and hyperspectral remote sensing images.
The methods are based on "Féret, J.-B., Asner, G.P., 2014.
Mapping tropical forest canopy diversity using high-fidelity imaging spectroscopy.
......@@ -21,10 +29,12 @@ Imports:
labdsv,
matlab,
matrixStats,
methods,
raster,
rgdal,
R.utils,
snow,
sp,
stringr,
tools,
vegan,
......
# Generated by roxygen2: do not edit by hand
S3method(split,line)
export(check_data)
export(diversity_from_plots)
export(get_projection)
......@@ -12,17 +11,21 @@ export(perform_PCA)
export(perform_radiometric_filtering)
export(raster2BIL)
export(select_PCA_components)
export(split_line)
import(raster)
import(tools)
importFrom(dissUtils,diss)
importFrom(ecodist,nmds)
importFrom(fields,rdist)
importFrom(future,multiprocess)
importFrom(future,plan)
importFrom(future,sequential)
importFrom(future.apply,future_lapply)
importFrom(labdsv,pco)
importFrom(matlab,ones)
importFrom(matlab,padarray)
importFrom(matrixStats,rowSds)
importFrom(methods,is)
importFrom(raster,projection)
importFrom(raster,raster)
importFrom(raster,shapefile)
......@@ -30,7 +33,13 @@ importFrom(raster,writeRaster)
importFrom(rgdal,readOGR)
importFrom(rgdal,writeOGR)
importFrom(snow,splitRows)
importFrom(sp,spTransform)
importFrom(stats,as.dist)
importFrom(stats,kmeans)
importFrom(stats,prcomp)
importFrom(stats,sd)
importFrom(stringr,str_count)
importFrom(utils,file.edit)
importFrom(utils,find)
importFrom(utils,read.table)
importFrom(vegan,fisher.alpha)
This diff is collapsed.
......@@ -11,7 +11,7 @@
# prepares data to run multithreaded continuum removal
#
# @param Spectral.Data initial data matrix (nb samples x nb bands)
# @param Spectral_Data initial data matrix (nb samples x nb bands)
# @param nbCPU
# @param Spectral information about spectral bands
#
......@@ -19,33 +19,33 @@
#' @importFrom snow splitRows
#' @importFrom future plan multiprocess sequential
#' @importFrom future.apply future_lapply
apply_continuum_removal <- function(Spectral.Data, Spectral, nbCPU = 1) {
apply_continuum_removal <- function(Spectral_Data, Spectral, nbCPU = 1) {
if (!length(Spectral$WaterVapor) == 0) {
Spectral.Data <- Spectral.Data[, -Spectral$WaterVapor]
Spectral_Data <- Spectral_Data[, -Spectral$WaterVapor]
}
# split data to perform continuum removal on into reasonable amount of data
nb.Values <- dim(Spectral.Data)[1] * dim(Spectral.Data)[2]
nb.Values <- dim(Spectral_Data)[1] * dim(Spectral_Data)[2]
if (nb.Values > 0) {
# corresponds to ~ 40 Mb data, but CR tends to requires ~ 10 times memory
# avoids memory crash
Max.nb.Values <- 2e6
nb.CR <- ceiling(nb.Values / Max.nb.Values)
Spectral.Data <- splitRows(Spectral.Data, nb.CR)
Spectral_Data <- splitRows(Spectral_Data, nb.CR)
# perform multithread continuum removal
plan(multiprocess, workers = nbCPU) ## Parallelize using four cores
Schedule.Per.Thread <- ceiling(nb.CR / nbCPU)
Spectral.Data.tmp <- future_lapply(Spectral.Data, FUN = ContinuumRemoval, Spectral.Bands = Spectral$Wavelength, future.scheduling = Schedule.Per.Thread)
Schedule_Per_Thread <- ceiling(nb.CR / nbCPU)
Spectral_Data_tmp <- future_lapply(Spectral_Data, FUN = ContinuumRemoval, Spectral_Bands = Spectral$Wavelength, future.scheduling = Schedule_Per_Thread)
plan(sequential)
Spectral.Data <- do.call("rbind", Spectral.Data.tmp)
rm(Spectral.Data.tmp)
Spectral_Data <- do.call("rbind", Spectral_Data_tmp)
rm(Spectral_Data_tmp)
} else {
# edit 31-jan-2018
# resize to delete first and last band as in continuum removal
Spectral.Data <- Spectral.Data[, -c(1, 2)]
Spectral_Data <- Spectral_Data[, -c(1, 2)]
}
gc()
return(Spectral.Data)
return(Spectral_Data)
}
# Computes continuum removal for matrix shaped data: more efficient than
......@@ -54,47 +54,47 @@ apply_continuum_removal <- function(Spectral.Data, Spectral, nbCPU = 1) {
# given spectral band and R at the following bands
#
# @param Minit initial data matrix (nb samples x nb bands)
# @param Spectral.Bands information about spectral bands
# @param Spectral_Bands information about spectral bands
#
# @return samples from image and updated number of pixels to sampel if necessary
ContinuumRemoval <- function(Minit, Spectral.Bands) {
ContinuumRemoval <- function(Minit, Spectral_Bands) {
# Filter and prepare data prior to continuum removal
CR.data <- filter_prior_CR(Minit, Spectral.Bands)
Minit <- CR.data$Minit
nb.Bands <- dim(Minit)[2]
CR.data$Minit <- c()
Spectral.Bands <- CR.data$Spectral.Bands
nb.Samples <- CR.data$nb.Samples
CR_data <- filter_prior_CR(Minit, Spectral_Bands)
Minit <- CR_data$Minit
nbBands <- dim(Minit)[2]
CR_data$Minit <- c()
Spectral_Bands <- CR_data$Spectral_Bands
nbSamples <- CR_data$nbSamples
# if samples to be considered
if (nb.Samples > 0) {
if (nbSamples > 0) {
# initialization:
# spectral band corresponding to each element of the data matrix
Lambda <- repmat(matrix(Spectral.Bands, nrow = 1), nb.Samples, 1)
Lambda <- repmat(matrix(Spectral_Bands, nrow = 1), nbSamples, 1)
# prepare matrices used to check evolution of the CR process
# - elements still not processed through continuum removal: initialization to 1
Still.Need.CR <- matrix(1, nrow = nb.Samples, ncol = nb.Bands)
Still.Need.CR <- matrix(1, nrow = nbSamples, ncol = nbBands)
# - value of the convex hull: initially set to 0
Convex.Hull <- matrix(0, nrow = nb.Samples, ncol = nb.Bands)
Convex_Hull <- matrix(0, nrow = nbSamples, ncol = nbBands)
# - reflectance value for latest interception with convex hull:
# initialization to value of the first reflectance measurement
Intercept.Hull <- repmat(matrix(Minit[, 1], ncol = 1), 1, nb.Bands)
Intercept_Hull <- repmat(matrix(Minit[, 1], ncol = 1), 1, nbBands)
# - spectral band of latest interception
Latest.Intercept <- repmat(matrix(Spectral.Bands[1], ncol = 1), nb.Samples, nb.Bands)
Latest.Intercept <- repmat(matrix(Spectral_Bands[1], ncol = 1), nbSamples, nbBands)
# number of spectral bands found as intercept
nb.Intercept <- 0
# continues until arbitrary stopping criterion:
# stops when reach last spectral band (all values before last = 0)
while (max(Still.Need.CR[, 1:(nb.Bands - 2)]) == 1 & (nb.Intercept <= (nb.Bands / 2))) {
while (max(Still.Need.CR[, 1:(nbBands - 2)]) == 1 & (nb.Intercept <= (nbBands / 2))) {
nb.Intercept <- nb.Intercept + 1
# Mstep give the position of the values to be updated
Update.Data <- matrix(1, nrow = nb.Samples, ncol = nb.Bands)
Update.Data[, nb.Bands] <- 0
Update_Data <- matrix(1, nrow = nbSamples, ncol = nbBands)
Update_Data[, nbBands] <- 0
# initial step: first column set to 0; following steps: all bands below
# max of the convex hull are set to 0
Update.Data[which((Lambda - Latest.Intercept) < 0)] <- 0
Update_Data[which((Lambda - Latest.Intercept) < 0)] <- 0
# compute slope for each coordinate
Slope <- (Minit - Intercept.Hull) / (Lambda - Latest.Intercept) * Still.Need.CR
Slope <- (Minit - Intercept_Hull) / (Lambda - Latest.Intercept) * Still.Need.CR
# set current spectral band and previous bands to -9999
if (!length(which(Still.Need.CR == 0)) == 0) {
Slope[which(Still.Need.CR == 0)] <- -9999
......@@ -103,25 +103,25 @@ ContinuumRemoval <- function(Minit, Spectral.Bands) {
Slope[which(is.na(Slope))] <- -9999
}
# get max index for each row and convert into linear index
Index.Max.Slope <- RowToLinear(max.col(Slope, ties.method = "last"), nb.Samples, nb.Bands)
Index.Max.Slope <- RowToLinear(max.col(Slope, ties.method = "last"), nbSamples, nbBands)
# !!!! OPTIM: replace repmat with column operation
# update coordinates of latest intercept
Latest.Intercept <- repmat(matrix(Lambda[Index.Max.Slope], ncol = 1), 1, nb.Bands)
Latest.Intercept <- repmat(matrix(Lambda[Index.Max.Slope], ncol = 1), 1, nbBands)
# update latest intercept
Intercept.Hull <- repmat(matrix(Minit[Index.Max.Slope], ncol = 1), 1, nb.Bands)
Intercept_Hull <- repmat(matrix(Minit[Index.Max.Slope], ncol = 1), 1, nbBands)
# values corresponding to the domain between the two continuum maxima
Update.Data[which((Lambda - Latest.Intercept) >= 0 | Latest.Intercept == Spectral.Bands[nb.Bands])] <- 0
Update_Data[which((Lambda - Latest.Intercept) >= 0 | Latest.Intercept == Spectral_Bands[nbBands])] <- 0
# values to eliminate for the next analysis: all spectral bands before latest intercept
Still.Need.CR[which((Lambda - Latest.Intercept) < 0)] <- 0
# the max slope is known, as well as the coordinates of the beginning and ending
# a matrix now has to be built
Convex.Hull <- Convex.Hull + Update.Data * (Intercept.Hull + sweep((Lambda - Latest.Intercept), 1, Slope[Index.Max.Slope], "*"))
Convex_Hull <- Convex_Hull + Update_Data * (Intercept_Hull + sweep((Lambda - Latest.Intercept), 1, Slope[Index.Max.Slope], "*"))
}
CR_Results0 <- Minit[, 2:(nb.Bands - 2)] / Convex.Hull[, 2:(nb.Bands - 2)]
CR_Results <- matrix(0, ncol = (nb.Bands - 3), nrow = nb.Samples)
CR_Results[CR.data$Samples.To.Keep, ] <- CR_Results0
CR_Results0 <- Minit[, 2:(nbBands - 2)] / Convex_Hull[, 2:(nbBands - 2)]
CR_Results <- matrix(0, ncol = (nbBands - 3), nrow = nbSamples)
CR_Results[CR_data$SamplesToKeep, ] <- CR_Results0
} else {
CR_Results <- matrix(0, ncol = (nb.Bands - 3), nrow = nb.Samples)
CR_Results <- matrix(0, ncol = (nbBands - 3), nrow = nbSamples)
}
list <- ls()
rm(list = list[-which(list == "CR_Results")])
......@@ -136,15 +136,15 @@ ContinuumRemoval <- function(Minit, Spectral.Bands) {
# - possibly remaining negative values are set to 0
# - constant spectra are eliminated
#
# @param Spectral.Bands
# @param Spectral_Bands
# @param Minit initial data matrix, n rows = n samples, p cols = p spectral bands
#
# @return updated Minit
#' @importFrom matrixStats rowSds
filter_prior_CR <- function(Minit, Spectral.Bands) {
filter_prior_CR <- function(Minit, Spectral_Bands) {
# number of samples to be processed
nb.Samples <- nrow(Minit)
nbSamples <- nrow(Minit)
# make sure there is no negative values
Minit <- Minit + 100.0
Minit[which(Minit < 0)] <- 0
......@@ -164,10 +164,10 @@ filter_prior_CR <- function(Minit, Spectral.Bands) {
Minit <- matrix(Minit, nrow = 1)
}
# add negative values to the last column and update spectral bands
Minit <- cbind(Minit, matrix(-9999, ncol = 1, nrow = nb.Samples))
nb.Bands <- ncol(Minit)
Spectral.Bands[nb.Bands] <- Spectral.Bands[nb.Bands - 1] + 10
my_list <- list("Minit" = Minit, "Spectral.Bands" = Spectral.Bands, "nb.Samples" = nb.Samples, "Samples.To.Keep" = keep)
Minit <- cbind(Minit, matrix(-9999, ncol = 1, nrow = nbSamples))
nbBands <- ncol(Minit)
Spectral_Bands[nbBands] <- Spectral_Bands[nbBands - 1] + 10
my_list <- list("Minit" = Minit, "Spectral_Bands" = Spectral_Bands, "nbSamples" = nbSamples, "SamplesToKeep" = keep)
return(my_list)
}
......
......@@ -11,38 +11,46 @@
#' Performs radiometric filtering based on three criteria: NDVI, NIR reflectance, Blue reflectance
#'
#' @param Image.Path character. Path of the image to be processed.
#' @param Mask.Path character. Path of the mask corresponding to the image.
#' @param Output.Dir character. output directory
#' @param TypePCA character. Type of PCA: "PCA" or "SPCA"
#' @param NDVI.Thresh numeric. NDVI threshold applied to produce a mask (select pixels with NDVI>NDVI.Thresh)
#' @param Blue.Thresh numeric. Blue threshold applied to produce a mask (select pixels with Blue refl < Blue.Thresh --> filter clouds) refl expected between 0 and 10000
#' @param NIR.Thresh numeric. NIR threshold applied to produce a mask (select pixels with NIR refl < NIR.Thresh) refl expected between 0 and 10000
#' @param Image_Path character. Path of the image to be processed
#' @param Mask_Path character. Path of the mask corresponding to the image
#' @param Output_Dir character. Path for output directory
#' @param TypePCA character. Type of PCA: choose either "PCA" or "SPCA"
#' @param NDVI_Thresh numeric. NDVI threshold applied to produce a mask (select pixels with NDVI>NDVI_Thresh)
#' @param Blue_Thresh numeric. Blue threshold applied to produce a mask (select pixels with Blue refl < Blue_Thresh --> filter clouds) refl expected between 0 and 10000
#' @param NIR_Thresh numeric. NIR threshold applied to produce a mask (select pixels with NIR refl < NIR_Thresh) refl expected between 0 and 10000
#' @param Blue numeric. central wavelength corresponding to the blue spectral band (in nanometers)
#' @param Red numeric. central wavelength corresponding to the red spectral band (in nanometers)
#' @param NIR numeric. central wavelength corresponding to the NIR spectral band (in nanometers)
#'
#' @return ImPathShade = updated shademask file
#' @return MaskPath = updated mask file
#' @export
perform_radiometric_filtering <- function(Image.Path, Mask.Path, Output.Dir, TypePCA = "SPCA", NDVI.Thresh = 0.5, Blue.Thresh = 500, NIR.Thresh = 1500, Blue = 480, Red = 700, NIR = 835) {
perform_radiometric_filtering <- function(Image_Path, Mask_Path, Output_Dir, TypePCA = "SPCA", NDVI_Thresh = 0.5, Blue_Thresh = 500, NIR_Thresh = 1500, Blue = 480, Red = 700, NIR = 835) {
# check if format of raster data is as expected
check_data(Image_Path)
if (!Mask_Path==FALSE){
check_data(Mask_Path,Mask = TRUE)
}
# define full output directory
Output.Dir.Full <- define_output_directory(Output.Dir, Image.Path, TypePCA)
Output_Dir_Full <- define_output_directory(Output_Dir, Image_Path, TypePCA)
# define dimensions of the image
ImPathHDR <- get_HDR_name(Image.Path)
ImPathHDR <- get_HDR_name(Image_Path)
HDR <- read_ENVI_header(ImPathHDR)
Image.Format <- ENVI_type2bytes(HDR)
Image_Format <- ENVI_type2bytes(HDR)
ipix <- as.double(HDR$lines)
jpix <- as.double(HDR$samples)
Nb.Pixels <- ipix * jpix
lenTot <- Nb.Pixels * as.double(HDR$bands)
ImSizeGb <- (lenTot * Image.Format$Bytes) / (1024^3)
nbPixels <- ipix * jpix
lenTot <- nbPixels * as.double(HDR$bands)
ImSizeGb <- (lenTot * Image_Format$Bytes) / (1024^3)
# Create / Update shade mask if optical data
if (Mask.Path == FALSE | Mask.Path == "") {
if (Mask_Path == FALSE | Mask_Path == "") {
print("Create mask based on NDVI, NIR and Blue threshold")
} else {
print("Update mask based on NDVI, NIR and Blue threshold")
}
Shade.Update <- paste(Output.Dir.Full, "ShadeMask_Update", sep = "")
Mask.Path <- create_mask_from_threshold(Image.Path, Mask.Path, Shade.Update, NDVI.Thresh, Blue.Thresh, NIR.Thresh, Blue, Red, NIR)
return(Mask.Path)
Shade.Update <- paste(Output_Dir_Full, "ShadeMask_Update", sep = "")
Mask_Path <- create_mask_from_threshold(Image_Path, Mask_Path, Shade.Update, NDVI_Thresh, Blue_Thresh, NIR_Thresh, Blue, Red, NIR)
return(Mask_Path)
}
# create a mask based on NDVI, Green reflectance and NIR reflectance
......@@ -52,42 +60,42 @@ perform_radiometric_filtering <- function(Image.Path, Mask.Path, Output.Dir, Typ
# ! only valid if Optical data!!
#
# @param ImPath full path of a raster file
# @param ImPathShade full path of the raster mask corresponding to the raster file
# @param ImPathShade.Update wavelength (nm) of the spectral bands to be found
# @param NDVI.Thresh NDVI threshold applied to produce a mask (select pixels with NDVI>NDVI.Thresh)
# @param Blue.Thresh Blue threshold applied to produce a mask (select pixels with Blue refl < Blue.Thresh --> filter clouds) refl expected between 0 and 10000
# @param NIR.Thresh NIR threshold applied to produce a mask (select pixels with NIR refl < NIR.Thresh) refl expected between 0 and 10000
# @param MaskPath full path of the raster mask corresponding to the raster file
# @param MaskPath.Update wavelength (nm) of the spectral bands to be found
# @param NDVI_Thresh NDVI threshold applied to produce a mask (select pixels with NDVI>NDVI_Thresh)
# @param Blue_Thresh Blue threshold applied to produce a mask (select pixels with Blue refl < Blue_Thresh --> filter clouds) refl expected between 0 and 10000
# @param NIR_Thresh NIR threshold applied to produce a mask (select pixels with NIR refl < NIR_Thresh) refl expected between 0 and 10000
#
# @return ImPathShade path for the updated shademask produced
create_mask_from_threshold <- function(ImPath, ImPathShade, ImPathShade.Update, NDVI.Thresh, Blue.Thresh, NIR.Thresh, Blue = 480, Red = 700, NIR = 835) {
# @return MaskPath path for the updated shademask produced
create_mask_from_threshold <- function(ImPath, MaskPath, MaskPath.Update, NDVI_Thresh, Blue_Thresh, NIR_Thresh, Blue = 480, Red = 700, NIR = 835) {
# define wavelength corresponding to the spectral domains Blue, Red and NIR
Spectral.Bands <- c(Blue, Red, NIR)
Spectral_Bands <- c(Blue, Red, NIR)
ImPathHDR <- get_HDR_name(ImPath)
Header <- read_ENVI_header(ImPathHDR)
# get image bands correponding to spectral bands of interest
Image.Bands <- get_image_bands(Spectral.Bands, Header$wavelength)
Image_Bands <- get_image_bands(Spectral_Bands, Header$wavelength)
# read band data from image
Image.Subset <- read_image_bands(ImPath, Header, Image.Bands$ImBand)
Image_Subset <- read_image_bands(ImPath, Header, Image_Bands$ImBand)
# create mask
# check if spectral bands required for NDVI exist
if (Image.Bands$Distance2WL[2] < 25 & Image.Bands$Distance2WL[3] < 25) {
NDVI <- ((Image.Subset[, , 3]) - (Image.Subset[, , 2])) / ((Image.Subset[, , 3]) + (Image.Subset[, , 2]))
if (Image_Bands$Distance2WL[2] < 25 & Image_Bands$Distance2WL[3] < 25) {
NDVI <- ((Image_Subset[, , 3]) - (Image_Subset[, , 2])) / ((Image_Subset[, , 3]) + (Image_Subset[, , 2]))
} else {
NDVI <- matrix(1, nrow = Header$lines, ncol = Header$samples)
message("Could not find the spectral bands required to compute NDVI")
}
if (Image.Bands$Distance2WL[1] > 25) {
Image.Subset[, , 1] <- Blue.Thresh + 0 * Image.Subset[, , 1]
if (Image_Bands$Distance2WL[1] > 25) {
Image_Subset[, , 1] <- Blue_Thresh + 0 * Image_Subset[, , 1]
message("Could not find a spectral band in the blue domain: will not perform filtering based on blue reflectance")
}
if (Image.Bands$Distance2WL[3] > 50) {
Image.Subset[, , 3] <- NIR.Thresh + 0 * Image.Subset[, , 3]
if (Image_Bands$Distance2WL[3] > 50) {
Image_Subset[, , 3] <- NIR_Thresh + 0 * Image_Subset[, , 3]
message("Could not find a spectral band in the NIR domain: will not perform filtering based on NIR reflectance")
}
Mask <- matrix(0, nrow = Header$lines, ncol = Header$samples)
SelPixels <- which(NDVI > NDVI.Thresh & Image.Subset[, , 1] < Blue.Thresh & Image.Subset[, , 3] > NIR.Thresh)
SelPixels <- which(NDVI > NDVI_Thresh & Image_Subset[, , 1] < Blue_Thresh & Image_Subset[, , 3] > NIR_Thresh)
Mask[SelPixels] <- 1
# update initial shade mask
ImPathShade <- update_shademask(ImPathShade, Header, Mask, ImPathShade.Update)
return(ImPathShade)
MaskPath <- update_shademask(MaskPath, Header, Mask, MaskPath.Update)
return(MaskPath)
}
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -55,6 +55,7 @@ list_shp <- function(x){
# @param Reprojected.File path for the reprojected shapefile
# @return
#' @importFrom rgdal readOGR writeOGR
#' @importFrom sp spTransform
#' @import tools
reproject_vector = function(Initial.File,Projection,Reprojected.File){
......@@ -135,13 +136,15 @@ get_alpha_metrics = function(Distrib){
}
#' gets alpha diversity indicators from plot
#' @param Raster SpectralSpecies file computed from DiverstyMapping method
#' @param Plots list of shapefiles included in the raster
#' @param Raster character. path for the SpectralSpecies file computed from DiverstyMapping method
#' @param Plots list. list of paths corresponding to shapefiles defining polygons in the raster
#' @param NbClusters numeric. Number of clusters defined in k-Means.
#' @param Name_Plot character. Name of the plots defined in the shapefile
#' @return alpha and beta diversity metrics
#' @importFrom rgdal readOGR
#' @import tools
#' @export
diversity_from_plots = function(Raster, Plots,NbClusters = 50,Name.Plot = FALSE){
diversity_from_plots = function(Raster, Plots,NbClusters = 50,Name_Plot = FALSE){
# get hdr from raster
HDR = read_ENVI_header(paste(Raster,'.hdr',sep=''))
nbRepetitions = HDR$bands
......@@ -188,8 +191,8 @@ diversity_from_plots = function(Raster, Plots,NbClusters = 50,Name.Plot = FALSE)
XY = extract_pixels_coordinates.From.OGR(Raster,Plot)
# if the plot is included in the raster
if (length(XY)==1 & length(XY[[1]]$Column)==0){
if (length(Name.Plot)==nbPlots){
Name.Plot[ip] = NA
if (length(Name_Plot)==nbPlots){
Name_Plot[ip] = NA
}
}
if (length(XY)>1 | length(XY[[1]]$Column)>0){
......@@ -273,14 +276,14 @@ diversity_from_plots = function(Raster, Plots,NbClusters = 50,Name.Plot = FALSE)
for(i in 1:nbRepetitions){
BC_mean = BC_mean+BC[[i]]
}
if (length(Name.Plot)>1){
elim = which(is.na(Name.Plot))
if (length(Name_Plot)>1){
elim = which(is.na(Name_Plot))
if (length(elim)>0){
Name.Plot = Name.Plot[-elim]
Name_Plot = Name_Plot[-elim]
}
}
BC_mean = as.matrix(BC_mean/nbRepetitions)
return(list("Richness" = Richness,"Fisher"=Fisher,"Shannon"=Shannon,"Simpson"=Simpson,'BCdiss' = BC_mean,"fisher.All"=Fisher.AllRep,"Shannon.All"=Shannon.AllRep,"Simpson.All"=Simpson.AllRep,'BCdiss.All' = BC,'Name.Plot'=Name.Plot))
return(list("Richness" = Richness,"Fisher"=Fisher,"Shannon"=Shannon,"Simpson"=Simpson,'BCdiss' = BC_mean,"fisher.All"=Fisher.AllRep,"Shannon.All"=Shannon.AllRep,"Simpson.All"=Simpson.AllRep,'BCdiss.All' = BC,'Name_Plot'=Name_Plot))
}
# build a vector file from raster footprint
......@@ -294,6 +297,7 @@ diversity_from_plots = function(Raster, Plots,NbClusters = 50,Name.Plot = FALSE)
# @return NULL
#' @importFrom rgdal readOGR
#' @importFrom raster writeRaster
#' @importFrom methods is
gdal_polygonizeR = function(x, outshape=NULL, gdalformat = 'ESRI Shapefile',
pypath=NULL, readpoly=TRUE, quiet=TRUE) {
......
......@@ -4,8 +4,7 @@
# 1 Install
After installing packages `devtools` and `getPass`, package `biodivMapR` can then be installed with the folloqing command line in R session, where `uname` is your gitlab.irstea.fr username:
```
devtools::install_git('https://gitlab.irstea.fr/jean-baptiste.feret/biodivMapR.git',
credentials = git2r::cred_user_pass("uname", getPass::getPass()))
devtools::install_git('https://gitlab.irstea.fr/jean-baptiste.feret/biodivMapR.git')
```
# 2 Tutorial
......
......@@ -6,58 +6,72 @@ knitr::opts_chunk$set(
)
## ----Input / Output files------------------------------------------------
# Input.Image.File = system.file('extdata', 'RASTER', 'S2A_T33NUD_20180104_Subset', package = 'biodivMapR')
# check_data(Input.Image.File)
# Input_Image_File = system.file('extdata', 'RASTER', 'S2A_T33NUD_20180104_Subset', package = 'biodivMapR')
#
# Input.Image.File = raster2BIL(Raster.Path = Input.Image.File,
# Sensor = 'SENTINEL_2A',
# Convert.Integer = TRUE,
# Output.Directory = '~/test')
# Input.Mask.File = FALSE
# # Input.Image.File = raster2BIL(Raster.Path = Input.Image.File,
# # Sensor = 'SENTINEL_2A',
# # Convert.Integer = TRUE,
# # Output.Directory = '~/test')
#
# Output.Dir = 'RESULTS'
# Input_Mask_File = FALSE
#
# Output_Dir = 'RESULTS'
## ----Spatial resolution--------------------------------------------------
# window_size = 10
## ----PCA filtering-------------------------------------------------------
# FilterPCA = TRUE
# FilterPCA = FALSE
## ----Computing options---------------------------------------------------
# nbCPU = 4
# nbCPU = 2
# MaxRAM = 0.5
# nbclusters = 50
## ----Mask non vegetated / shaded / cloudy pixels-------------------------
# NDVI.Thresh = 0.5
# Blue.Thresh = 500
# NIR.Thresh = 1500
# NDVI_Thresh = 0.5
# Blue_Thresh = 500
# NIR_Thresh = 1500
# print("PERFORM RADIOMETRIC FILTERING")
# ImPathShade = perform_radiometric_filtering(Input.Image.File, Input.Mask.File, Output.Dir,
# NDVI.Thresh = NDVI.Thresh, Blue.Thresh = Blue.Thresh,
# NIR.Thresh = NIR.Thresh)
# Input_Mask_File = perform_radiometric_filtering(Input_Image_File, Input_Mask_File, Output_Dir,
# NDVI_Thresh = NDVI_Thresh, Blue_Thresh = Blue_Thresh,
# NIR_Thresh = NIR_Thresh)
## ----PCA-----------------------------------------------------------------
# print("PERFORM PCA ON RASTER")
# PCA.Files = perform_PCA(Input.Image.File, ImPathShade, Output.Dir,
# FilterPCA = TRUE, nbCPU = nbCPU, MaxRAM = MaxRAM)
# PCA_Output = perform_PCA(Input_Image_File, Input_Mask_File, Output_Dir,
# FilterPCA = TRUE, nbCPU = nbCPU,MaxRAM = MaxRAM)
# # path for the PCA raster
# PCA_Files = PCA_Output$PCA_Files
# # number of pixels used for each partition used for k-means clustering
# Pix_Per_Partition = PCA_Output$Pix_Per_Partition
# # number of partitions used for k-means clustering
# nb_partitions = PCA_Output$nb_partitions
# # path for the updated mask
# Input_Mask_File = PCA_Output$MaskPath
# # parameters of the PCA model
# PCA_model = PCA_Output$PCA_model
# # definition of spectral bands to be excluded from the analysis
# SpectralFilter = PCA_Output$SpectralFilter
#
# print("Select PCA components for diversity estimations")
# select_PCA_components(Input.Image.File, Output.Dir, PCA.Files, File.Open = TRUE)
# select_PCA_components(Input_Image_File, Output_Dir, PCA_Files, File_Open = TRUE)
## ----alpha and beta diversity maps---------------------------------------
## ----Spectral species map------------------------------------------------
# print("MAP SPECTRAL SPECIES")
# map_spectral_species(Input.Image.File, Output.Dir, PCA.Files,
# nbCPU = nbCPU, MaxRAM = MaxRAM)
#
# map_spectral_species(Input_Image_File, Output_Dir, PCA_Files,PCA_model, SpectralFilter, Input_Mask_File,
# Pix_Per_Partition, nb_partitions, nbCPU=nbCPU, MaxRAM=MaxRAM)
## ----alpha and beta diversity maps---------------------------------------
# print("MAP ALPHA DIVERSITY")
# # Index.Alpha = c('Shannon','Simpson')
# Index.Alpha = c('Shannon')
# map_alpha_div(Input.Image.File, Output.Dir, window_size,
# nbCPU = nbCPU, MaxRAM = MaxRAM, Index.Alpha = Index.Alpha)
# Index_Alpha = c('Shannon')
# map_alpha_div(Input_Image_File, Output_Dir, window_size,
# nbCPU=nbCPU, MaxRAM=MaxRAM, Index_Alpha = Index_Alpha)
#
# print("MAP BETA DIVERSITY")
# map_beta_div(Input.Image.File, Output.Dir, window_size,
# nbCPU = nbCPU, MaxRAM = MaxRAM)
# map_beta_div(Input_Image_File, Output_Dir, window_size, nb_partitions=nb_partitions,
# nbCPU=nbCPU, MaxRAM=MaxRAM)
## ----alpha and beta diversity indices from vector layer------------------
# # location of the spectral species raster needed for validation
......@@ -71,13 +85,9 @@ knitr::opts_chunk$set(
# Shannon.All = list() # ??
#
# # list vector data
# Path.Vector = list.shp(vect)
# Path.Vector = list_shp(vect)
# Name.Vector = tools::file_path_sans_ext(basename(Path.Vector))
#
# # read raster data including projection
# RasterStack = stack(Path.Raster)
# Projection.Raster = projection.file(Path.Raster,'raster')
#
# # get alpha and beta diversity indicators corresponding to shapefiles
# Biodiv.Indicators = diversity_from_plots(Raster = Path.Raster, Plots = Path.Vector,NbClusters = nbclusters)
# # if no name
......@@ -104,3 +114,52 @@ knitr::opts_chunk$set(
# write.table(BC_mean, file = paste(Path.Results,"BrayCurtis.csv",sep=''), sep="\t", dec=".", na=" ", row.names = F, col.names= T,quote=FALSE)
#
## ----PCoA on Field Plots-------------------------------------------------
# # apply ordination using PCoA (same as done for map_beta_div)
# library(labdsv)
# MatBCdist = as.dist(BC_mean, diag = FALSE, upper = FALSE)
# BetaPCO = pco(MatBCdist, k = 3)
#
## ----plot PCoA & Shannon-------------------------------------------------
# # very uglily assign vegetation type to polygons in shapefiles
# nbSamples = c(6,4,7,7)
# vg = c('Forest high diversity', 'Forest low diversity', 'Forest medium diversity', 'low vegetation')
# Type_Vegetation = c()
# for (i in 1: length(nbSamples)){
# for (j in 1:nbSamples[i]){
# Type_Vegetation = c(Type_Vegetation,vg[i])
# }
# }
#
# # create data frame including alpha and beta diversity
# library(ggplot2)
# Results = data.frame('vgtype'=Type_Vegetation,'pco1'= BetaPCO$points[,1],'pco2'= BetaPCO$points[,2],'pco3' = BetaPCO$points[,3],'shannon'=Shannon.RS)
#
# # plot field data in the PCoA space, with size corresponding to shannon index
# ggplot(Results, aes(x=pco1, y=pco2, color=vgtype,size=shannon)) +
# geom_point(alpha=0.6) +
# scale_color_manual(values=c("#e6140a", "#e6d214", "#e68214", "#145ae6"))
# filename = file.path(Path.Results,'BetaDiversity_PcoA1_vs_PcoA2.png')
# ggsave(filename, plot = last_plot(), device = 'png', path = NULL,
# scale = 1, width = NA, height = NA, units = c("in", "cm", "mm"),
# dpi = 600, limitsize = TRUE)
#
#
# ggplot(Results, aes(x=pco1, y=pco3, color=vgtype,size=shannon)) +
# geom_point(alpha=0.6) +
# scale_color_manual(values=c("#e6140a", "#e6d214", "#e68214", "#145ae6"))
# filename = file.path(Path.Results,'BetaDiversity_PcoA1_vs_PcoA3.png')
# ggsave(filename, plot = last_plot(), device = 'png', path = NULL,
# scale = 1, width = NA, height = NA, units = c("in", "cm", "mm"),
# dpi = 600, limitsize = TRUE)
#
# ggplot(Results, aes(x=pco2, y=pco3, color=vgtype,size=shannon)) +
# geom_point(alpha=0.6) +
# scale_color_manual(values=c("#e6140a", "#e6d214", "#e68214", "#145ae6"))
# filename = file.path(Path.Results,'BetaDiversity_PcoA2_vs_PcoA3.png')
# ggsave(filename, plot = last_plot(), device = 'png', path = NULL,
# scale = 1, width = NA, height = NA, units = c("in", "cm", "mm"),
# dpi = 600, limitsize = TRUE)
#
This diff is collapsed.
This diff is collapsed.
......@@ -28,24 +28,23 @@ library(biodivMapR)
################################################################################
# path (absolute or relative) for the image to process
# expected to be in ENVI HDR format, BIL interleaved
Input.Image.File = system.file('extdata', 'RASTER', 'S2A_T33NUD_20180104_Subset', package = 'biodivMapR')
check_data(Input.Image.File)
Input_Image_File = system.file('extdata', 'RASTER', 'S2A_T33NUD_20180104_Subset', package = 'biodivMapR')
# # convert the image using Convert.Raster2BIL if not in the proper format
# Input.Image.File = raster2BIL(Raster.Path = Input.Image.File,
# Input_Image_File = raster2BIL(Raster_Path = Input_Image_File,
# Sensor = 'SENTINEL_2A',
# Convert.Integer = TRUE,