Commit 9747c472 authored by Monnet Jean-Matthieu's avatar Monnet Jean-Matthieu

modify call to grid_metrics and las_metrics (as formula)

parent 19343ca6
......@@ -8,7 +8,7 @@ Maintainer: Jean-Matthieu Monnet <jean-matthieu.monnet@irstea.fr>
Description: Provides functions for forest analysis using airborne laser scanning data. It includes complementary steps for foret mapping: extraction of both physical and statistical features from lidar data, model calibration with ground reference, and maps export.
URL: https://gitlab.irstea.fr/jean-matthieu.monnet/lidaRtRee
BugReports: https://gitlab.irstea.fr/jean-matthieu.monnet/lidaRtRee/issues
Imports: graphics, stats, grDevices, sp, raster, imager, akima, leaps, gvlma, car, foreach, doParallel, reldist, lidR (>= 2.0.0)
License: GPL-3
Imports: graphics, stats, grDevices, sp, raster, imager, akima, leaps, gvlma, car, foreach, doParallel, reldist, lidR (>= 2.0.0), methods
License: GPL-3 + file LICENSE
LazyData: TRUE
RoxygenNote: 6.1.1
......@@ -213,6 +213,12 @@ lmaCheck <- function(formule, df, max.pvalue=0.05, max.vif=5)
#'@export
BoxcoxTr <- function(x,lambda)
{
count.neg <- sum(x<0)
if (count.neg >0)
{
x[x<0] <- 0
warning(paste0(count.neg, " negative value(s) set to 0"))
}
if (lambda !=0)
{
(x^lambda-1)/lambda
......@@ -229,6 +235,12 @@ BoxcoxTr <- function(x,lambda)
#'@export
iBoxcoxTr <- function(x,lambda)
{
count.neg <- sum(x<0)
if (count.neg >0)
{
x[x<0] <- 0
warning(paste0(count.neg, " negative value(s) set to 0"))
}
if (lambda !=0)
{
(lambda * x +1)^(1/lambda)
......@@ -260,7 +272,7 @@ iBoxcoxTrBiasCor <- function(x,lambda,varmod)
#' combines a list of models corresponding to a stratification into a single object
#'
#' @param modells list .models returned by \code{\link{ABAmodel}}
#' @param plots vector. plotId values in order to re-order the values in the model object
#' @param plotsId vector. plotsId values in order to re-order the values in the model object
#' @return a model object with statistics corresponding to the combination of stratified models
#' @export
#'
......@@ -313,15 +325,24 @@ ABAmodelCombineStrata <- function(modells, plotsId=NULL)
#' @param title string. the plot title
#' @param unit numeric. the plot title (between parenthesis)
#' @param disp.text boolean indicates if points should be labelled with id
#' @param ... other parameters to be passed to \code{\link[graphics]{plot}}
#' @return nothing
#' @export
#'
ABAmodelPlot <- function(modell, title=NULL, unit=NULL, disp.text=F)
ABAmodelPlot <- function(modell, title=NULL, unit=NULL, disp.text=F, ...)
{
if (nrow(modell$stats)>1) # if stratified model, color values by stratum
{
col <- modell$values$stratum
} else { col <- "black"}
# color
if (!methods::hasArg(col)) {
if (nrow(modell$stats)>1) # if stratified model, color values by stratum
{
col <- modell$values$stratum
} else { col <- "black"}
} else { col <- list(...)$col}
# pch
if (!methods::hasArg(pch)) {
pch <- 1
} else { pch <- list(...)$pch}
#
main <- NULL
if (!is.null(title))
{
......@@ -332,7 +353,7 @@ ABAmodelPlot <- function(modell, title=NULL, unit=NULL, disp.text=F)
main <- paste(main, " (", unit, ")",sep="")
}
if (disp.text) {cex.points <- 0.1} else {cex.points <- 1} # size of dots if text is present
graphics::plot(modell[["values"]]$field, modell[["values"]]$predicted,asp=1, xlab="Field", ylab="Predicted in LOOCV", main=main, col=col, cex=cex.points)
graphics::plot(modell[["values"]]$field, modell[["values"]]$predicted,asp=1, xlab="Field", ylab="Predicted in LOOCV", main=main, col=col, cex=cex.points, pch=pch)
graphics::abline(c(0,1))
if (nrow(modell$stats)>1) # if stratified model
{
......@@ -402,21 +423,21 @@ ABApredict <- function(modell, map.metrics, strata=NULL)
#' @return a raster object
#' @export
#'
cleanPredictionRaster <- function(r, minmax=c(-Inf, +Inf), mask=NULL)
cleanPredictionRaster <- function(rast, minmax=c(-Inf, +Inf), mask=NULL)
{
# if mask is present
if (! is.null(mask))
{
# fill NA values in rast with 0
r[is.na(r)] <- 0
rast[is.na(rast)] <- 0
# then apply mask
r <- r * mask
rast <- rast * mask
}
#
r[r<minmax[1]] <- minmax[1]
r[r>minmax[2]] <- minmax[2]
rast[rast<minmax[1]] <- minmax[1]
rast[rast>minmax[2]] <- minmax[2]
#
return(r)
return(rast)
}
####################################
#' computes inference from area-based model and predicted values
......
......@@ -36,10 +36,10 @@
#' sd.z = stats::sd(z[z>hmin])
#' ))
#' }
#' cloudMetrics(llas, func=user.func(Z, ReturnNumber, 10))
#' cloudMetrics(llas, func=~user.func(Z, ReturnNumber, 10))
#' @export
#'
cloudMetrics <- function(llasn, func=lidR::stdmetrics(X,Y,Z,Intensity, ScanAngle, ReturnNumber, Classification, dz = 1))
cloudMetrics <- function(llasn, func=~lidR::stdmetrics(X,Y,Z,Intensity, ReturnNumber, Classification, dz = 1))
{
# apply lidR::lasmetrics to compute metrics
metrics <- lapply(llasn, function(x){lidR::lasmetrics(x, func)})
......@@ -213,7 +213,8 @@ points2terrainStats <- function(p, centre=NULL, r=NULL)
if (!is.null(centre))
{
altitude <- akima::interpp(x=p$X, y=p$Y, z=p$Z, xo=centre[1], yo=centre[2], linear=TRUE, duplicate="median")$z
} else {altitude <- mean(range(p$Z))}
} else {altitude <- NA}
if (is.na(altitude)) {altitude <- mean(range(p$Z))}
# output
round(data.frame(altitude=altitude, azimut.gr=azimut, slope.gr=slope, adjR2.plane=summary(modlin)$adj.r.squared * 100),1)
} else { NULL}
......
......@@ -9,7 +9,7 @@ ABAmodelCombineStrata(modells, plotsId = NULL)
\arguments{
\item{modells}{list .models returned by \code{\link{ABAmodel}}}
\item{plots}{vector. plotId values in order to re-order the values in the model object}
\item{plotsId}{vector. plotsId values in order to re-order the values in the model object}
}
\value{
a model object with statistics corresponding to the combination of stratified models
......
......@@ -4,7 +4,7 @@
\alias{ABAmodelPlot}
\title{plots observed and predicted values of a model returned by \code{\link{ABAmodel}}}
\usage{
ABAmodelPlot(modell, title = NULL, unit = NULL, disp.text = F)
ABAmodelPlot(modell, title = NULL, unit = NULL, disp.text = F, ...)
}
\arguments{
\item{modell}{list. as returned by \code{\link{ABAmodel}}}
......@@ -14,6 +14,8 @@ ABAmodelPlot(modell, title = NULL, unit = NULL, disp.text = F)
\item{unit}{numeric. the plot title (between parenthesis)}
\item{disp.text}{boolean indicates if points should be labelled with id}
\item{...}{other parameters to be passed to \code{\link[graphics]{plot}}}
}
\value{
nothing
......
......@@ -4,14 +4,14 @@
\alias{cleanPredictionRaster}
\title{applies thresholds and mask to a prediction map}
\usage{
cleanPredictionRaster(r, minmax = c(-Inf, +Inf), mask = NULL)
cleanPredictionRaster(rast, minmax = c(-Inf, +Inf), mask = NULL)
}
\arguments{
\item{rast}{raster object. model predictions}
\item{minmax}{vector of two numeric values. minimum and maximum thresholds to apply to raster values}
\item{mask}{raster object. region of interest (NA values will be applied elsewhere)}
\item{rast}{raster object. model predictions}
}
\value{
a raster object
......
......@@ -4,8 +4,8 @@
\alias{cloudMetrics}
\title{Computes metrics on list of point clouds}
\usage{
cloudMetrics(llasn, func = lidR::stdmetrics(X, Y, Z, Intensity,
ScanAngle, ReturnNumber, Classification, dz = 1))
cloudMetrics(llasn, func = ~lidR::stdmetrics(X, Y, Z, Intensity,
ReturnNumber, Classification, dz = 1))
}
\arguments{
\item{llasn}{list of LAS objects (e.g. from \code{\link[lidR]{LAS}} function)}
......@@ -43,7 +43,7 @@ return(list(
sd.z = stats::sd(z[z>hmin])
))
}
cloudMetrics(llas, func=user.func(Z, ReturnNumber, 10))
cloudMetrics(llas, func=~user.func(Z, ReturnNumber, 10))
}
\seealso{
\code{\link[lidR]{lasmetrics}}, \code{\link[lidR]{stdmetrics}}, \code{\link{ABAmodelMetrics}}
......
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