Commit 835bc8a7 authored by Monnet Jean-Matthieu's avatar Monnet Jean-Matthieu

Added cloudTreeMetrics 2

parent 9747c472
......@@ -389,6 +389,8 @@ plotTreeInventory <-function(xy, height=NULL, diam=NULL, species=NULL, add=FALSE
#' @export
rasterXYMask <- function(xy, buff, r, binary=TRUE)
{
# convert vector to data.frame in case only one pair of coodinates is provided
if (length(xy) == 2) {xy <- data.frame(matrix(coord, 1, 2))}
# compute squared buffers
buff2 <- buff^2
# compute XY coordinates of cell centers
......
......@@ -220,46 +220,44 @@ points2terrainStats <- function(p, centre=NULL, r=NULL)
} else { NULL}
}
#' ################################
#' #' compute tree metrics for list of LAS objects (should be normalized clouds, with buffer around area of interest). Call the treedetection function on each object and then arranges the results in a data.frame
#' #'
#' #' @param llasn list of LAS objects (from lidR package)
#' #' @param XY a dataframe or matrix with XY coordinates of plot centers
#' #' @param plot.radius a numeric plot radius in m
#' #' @param res CHM resolution for tree detection (m)
#' #' @param hmin min height for a tree (m)
#' #' @param h.points height for CHM thresholding (m)
#' #' @param func a function to be applied to the attributes of extracted trees (return from internal call to treeExtraction function to compute plot level metrics
#' #' @return a dataframe with tree metrics in columns corresponding to LAS objects of the list (lines)
#' #' @export
#' #'
#' cloudTreeMetrics <- function(llasn, XY, plot.radius, res=0.5, hmin=5, h.points=60, func=stdTreeMetrics)
#' {
#' # metrics <- parallel::mclapply(llasn, function(x){lidR::lasmetrics(x, func)}, max(detectCores()-1,1))
#' # removed parallelization because of bug
#' # row.names(metrics) <- names(llasn)
#' plot.area.ha <- pi*plot.radius^2/10000
#' xy.list <- split(XY, seq(nrow(XY)))
#' # return(metrics)
#' lsegms <- parallel::mcmapply(function(x, coord){
#' # compute dsm
#' dummy <- points2DSM(x,res=res)
#' # replace NA, low and high values
#' dummy[is.na(dummy) | dummy<0 | dummy>h.points] <- 0
#' # tree detection
#' dummy <- treeSegmentation(dummy, hmin=hmin)
#' # tree extraction
#' return(treeExtraction(dummy[[1]], dummy[[2]], dummy[[3]], rasterTreeMask(coord, plot.radius, dummy[[1]], binary=T)))
#' },
#' llasn, xy.list, SIMPLIFY=F, USE.NAMES=T)
#' # remove trees which apex is outside of tile#
#' # for (i in 1:length(lsegms))
#' # {
#' # dummy <- lsegms[[i]]
#' # lsegms[[i]] <- dummy[(dummy$x-XY[i,1])^2+(dummy$y-XY[i,2])^2<=plot.radius^2,]
#' # }
#' # compute plot metrics
#' tree.metrics <- parallel::mclapply(lsegms, FUN=func)
#' # bind data.frames
#' tree.metrics <- do.call(rbind,tree.metrics)
#' }
################################
#' compute tree metrics for list of LAS objects (should be normalized clouds, with buffer around area of interest). Call the treedetection function on each object and then arranges the results in a data.frame
#'
#' @param llasn list of LAS objects (from lidR package)
#' @param XY a dataframe or matrix with XY coordinates of plot centers
#' @param plot.radius a numeric plot radius in m
#' @param res CHM resolution for tree detection (m)
#' @param hmin min height for a tree (m)
#' @param h.points height for CHM thresholding (m)
#' @param func a function to be applied to the attributes of extracted trees (return from internal call to treeExtraction function to compute plot level metrics
#' @return a dataframe with tree metrics in columns corresponding to LAS objects of the list (lines)
#' @export
#'
cloudTreeMetrics <- function(llasn, XY, plot.radius, res=0.5, hmin=5, h.points=60, func=stdTreeMetrics)
{
# ADD example
# ALLOW ... parameters to be passed to treeSegmentation
plot.area.ha <- pi*plot.radius^2/10000
xy.list <- split(XY, seq(nrow(XY)))
# LOOP on list <- replace by lapply
lsegms <- list()
for (i in 1:length(llasn))
{
x <- llasn[[i]]
coord <- xy.list[[i]]
# compute dsm
dummy <- points2DSM(x,res=res)
# replace NA, low and high values
dummy[is.na(dummy) | dummy<0 | dummy>h.points] <- 0
# tree detection
dummy <- treeSegmentation(dummy, hmin=hmin)
# tree extraction
lsegms[[i]] <- treeExtraction(dummy$filled.dem, dummy$local.maxima, dummy$segments.id, rasterXYMask(coord, plot.radius, dummy$local.maxima, binary=T))
}
# GERER les cas ou pas d'arbre detecte ??
# GERER les NA
# compute metrics
tree.metrics <- lapply(lsegms, FUN=function(x){func(x, area.ha=plot.area.ha)})
# bind data.frames
tree.metrics <- do.call(rbind,tree.metrics)
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment