diff --git a/.Rbuildignore b/.Rbuildignore
index 10d7fce..fde1088 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -7,3 +7,5 @@
^docs$
^pkgdown$
^CITATION\.cff$
+^\.positai$
+^\.claude$
diff --git a/.gitignore b/.gitignore
index 7c6f7b0..6d8aefc 100644
--- a/.gitignore
+++ b/.gitignore
@@ -6,3 +6,4 @@
docs
+.positai
diff --git a/DESCRIPTION b/DESCRIPTION
index a09989e..3b490fd 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -17,13 +17,13 @@ Description: With this package you can obtain structural metrics from individual
License: MIT + file LICENSE
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.3
Imports:
alphashape3d,
concaveman,
data.table,
ggforce,
ggplot2,
+ nabor,
graphics,
lidR,
nabor,
@@ -47,3 +47,4 @@ Suggests:
testthat (>= 3.0.0)
VignetteBuilder: knitr
Config/testthat/edition: 3
+Config/roxygen2/version: 8.0.0
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..bdc072c
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,19 @@
+# ITSMe 2.0.0.9000
+
+## DBH estimation and quality control
+
+- Added more robust DBH estimation through the `how`
+ argument. The original ITSMe behaviour can be obtained with `how = "mean"`;
+ `how = "median"` (new default) uses the median point-to-centre radius; and numeric values
+ use a trimmed mean of the point-to-centre radii.
+- Added DBH quality-control metrics to `diameter_slice_pc()` and `dbh_pc()`:
+ `arc_coverage` and `inner_circle_empty`.
+- Updated `summary_basic_pointcloud_metrics_pertree()` and
+ `summary_basic_pointcloud_metrics()` so DBH quality-control metrics are
+ included in the returned summary data frame when `"stem diameter"` is
+ calculated.
+- Updated the lower-trunk fallback logic in `dbh_pc()` so that a well-supported
+ direct DBH slice is less likely to be overwritten because of noisy or
+ incomplete lower-stem points.
+- Documented the new DBH estimation options and quality-control metrics in the
+ main ITSMe vignette.
\ No newline at end of file
diff --git a/R/basic_metrics_pc.R b/R/basic_metrics_pc.R
index f5b73f4..00c1392 100644
--- a/R/basic_metrics_pc.R
+++ b/R/basic_metrics_pc.R
@@ -125,8 +125,8 @@ tree_height_pc <- function(pc,
pc_norm <- pc
pc_norm$Z <- pc$Z - z_min
X <- Y <- Z <- NULL
- plotXZ <- ggplot2::ggplot(pc_norm, ggplot2::aes(X, Z), col = plotcolors[1]) +
- ggplot2::geom_point(size = 0.1, shape = ".") +
+ plotXZ <- ggplot2::ggplot(pc_norm, ggplot2::aes(X, Z)) +
+ ggplot2::geom_point(size = 0.1, shape = ".", color = plotcolors[1]) +
ggplot2::geom_hline(yintercept = max(pc_norm$Z), lty = 'dashed') +
ggplot2::scale_y_continuous(expand = c(0, 0)) +
ggplot2::coord_fixed(ratio = 1) +
@@ -134,11 +134,11 @@ tree_height_pc <- function(pc,
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"),
axis.text.x = ggplot2::element_blank(),
axis.ticks.x = ggplot2::element_blank(),
@@ -157,7 +157,7 @@ tree_height_pc <- function(pc,
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
axis.text.y = ggplot2::element_blank(),
@@ -187,8 +187,8 @@ tree_height_pc <- function(pc,
)
)
} else {
- plotYZ <- ggplot2::ggplot(pc_norm, ggplot2::aes(Y, Z), col = plotcolors[1]) +
- ggplot2::geom_point(size = 0.1, shape = ".") +
+ plotYZ <- ggplot2::ggplot(pc_norm, ggplot2::aes(Y, Z)) +
+ ggplot2::geom_point(size = 0.1, shape = ".", color = plotcolors[1]) +
ggplot2::geom_hline(yintercept = max(pc_norm$Z), lty = 'dashed') +
ggplot2::scale_y_continuous(expand = c(0, 0)) +
ggplot2::coord_fixed(ratio = 1) +
@@ -196,7 +196,7 @@ tree_height_pc <- function(pc,
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
axis.text.y = ggplot2::element_blank(),
@@ -256,6 +256,7 @@ tree_height_pc <- function(pc,
#' Ri <- calc_r(x_dbh, y_dbh, x_c, y_c)
#' R <- mean(Ri)
#' }
+
calc_r <- function(x, y, xc, yc) {
return(sqrt((x - xc) ** 2 + (y - yc) ** 2))
}
@@ -284,6 +285,233 @@ f <- function(c, x, y) {
return(sum((Ri - mean(Ri)) ** 2))
}
+#' Summarise point-to-centre radii
+#'
+#' Internal helper used by \code{\link{diameter_slice_pc}} to summarise
+#' point-to-centre distances into one fitted radius.
+#'
+#' @param Ri Numeric vector of point-to-centre distances.
+#' @param how Method used to summarise the radii. Use \code{"mean"} for the
+#' original ITSMe behaviour, \code{"median"} for the median radius, or a
+#' numeric value such as \code{10} to trim 5 percent of radii on each side
+#' before taking the mean.
+#'
+#' @return Numeric radius estimate.
+#'
+#' @noRd
+
+get_radius <- function(Ri, how = "median") {
+
+ if (is.character(how)) {
+ how <- tolower(trimws(how))
+
+ if (how == "mean") {
+ return(mean(Ri))
+ }
+
+ if (how == "median") {
+ return(stats::median(Ri))
+ }
+
+ stop("`how` must be 'mean', 'median', or a numeric trim percentage.")
+ }
+
+ if (is.numeric(how)) {
+ if (length(how) != 1 || is.na(how)) {
+ stop("`how` must be one numeric value.")
+ }
+
+ if (how < 0 || how >= 100) {
+ stop("Numeric `how` must be >= 0 and < 100.")
+ }
+
+ if (how == 0) {
+ return(mean(Ri))
+ }
+
+ q <- how / 2 / 100
+
+ q_low <- stats::quantile(Ri, q, names = FALSE)
+ q_high <- stats::quantile(Ri, 1 - q, names = FALSE)
+ Ri_trimmed <- Ri[Ri >= q_low & Ri <= q_high]
+
+ return(mean(Ri_trimmed))
+ }
+
+ stop("`how` must be 'mean', 'median', or a numeric trim percentage.")
+}
+
+#' Calculate arc coverage of a fitted stem circle
+#'
+#' Internal helper used as a quality-control metric for fitted diameter circles.
+#' Arc coverage is the proportion of angular sectors around the fitted circle
+#' that contain at least one point close to the fitted circumference.
+#'
+#' @param slice_points A data.frame containing slice points with columns X and Y.
+#' @param radius Numeric. Radius of the fitted circle, in metres.
+#' @param xc Numeric. X-coordinate of the fitted circle centre.
+#' @param yc Numeric. Y-coordinate of the fitted circle centre.
+#' @param arc_min_length_cm Optional numeric. Minimum arc length, in centimetres,
+#' represented by one angular sector.
+#' @param arc_min_angle Numeric. Minimum angular sector width in degrees.
+#' @param arc_tolerance Numeric. Radial tolerance, in metres, around the fitted
+#' circle. Points within radius +/- arc_tolerance are counted as supporting
+#' the fitted circle.
+#'
+#' @return Numeric value between 0 and 1.
+#'
+#' @noRd
+
+arc_coverage <- function(slice_points,
+ radius,
+ xc,
+ yc,
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05) {
+ if (is.null(slice_points) || nrow(slice_points) == 0 ||
+ is.na(radius) || is.nan(radius) || radius <= 0 ||
+ is.na(xc) || is.na(yc)) {
+ return(NA_real_)
+ }
+
+ if (!all(c("X", "Y") %in% names(slice_points))) {
+ stop("`slice_points` must contain columns X and Y.", call. = FALSE)
+ }
+
+ if (!is.null(arc_min_length_cm)) {
+ degrees_from_arc_length <- (arc_min_length_cm * 0.01) /
+ (radius * 2 * pi / 360)
+ degrees <- max(degrees_from_arc_length, arc_min_angle)
+ } else {
+ degrees <- arc_min_angle
+ }
+
+ dx <- slice_points$X - xc
+ dy <- slice_points$Y - yc
+
+ angles <- atan2(dy, dx) * 180 / pi
+ angles <- ifelse(angles < 0, angles + 360, angles)
+
+ distances <- sqrt(dx^2 + dy^2)
+
+ in_donut <- distances > radius - arc_tolerance &
+ distances < radius + arc_tolerance
+
+ selected_angles <- angles[in_donut]
+
+ if (length(selected_angles) == 0) {
+ return(0)
+ }
+
+ angle_starts <- seq(0, 360 - degrees, by = degrees)
+
+ sector_has_point <- vapply(angle_starts, function(angle_start) {
+ angle_end <- angle_start + degrees
+ any(selected_angles >= angle_start & selected_angles < angle_end)
+ }, logical(1))
+
+ mean(sector_has_point)
+}
+
+#' Check whether the inner part of a fitted stem circle is empty
+#'
+#' Internal helper used as a quality-control metric for fitted diameter circles.
+#' The function checks whether any slice points occur inside an inner circle
+#' around the fitted centre. The inner circle radius is calculated as the fitted
+#' radius minus a buffer around the stem surface.
+#'
+#' @param slice_points A data.frame containing slice points with columns X and Y.
+#' @param radius Numeric. Radius of the fitted circle, in metres.
+#' @param xc Numeric. X-coordinate of the fitted circle centre.
+#' @param yc Numeric. Y-coordinate of the fitted circle centre.
+#' @param min_inner_buffer Numeric. Minimum buffer distance, in metres, excluded
+#' from the fitted radius before checking the inner circle.
+#' @param inner_buffer_fraction Numeric. Fraction of the fitted radius used as
+#' buffer before checking the inner circle. The effective buffer is
+#' \code{max(min_inner_buffer, inner_buffer_fraction * radius)}.
+#'
+#' @return Logical. TRUE if no points occur inside the checked inner circle,
+#' FALSE if at least one point occurs inside it, and NA if the check cannot be
+#' performed.
+#'
+#' @noRd
+
+
+inner_circle_empty <- function(slice_points,
+ radius,
+ xc,
+ yc,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5) {
+ if (is.null(slice_points) || nrow(slice_points) == 0 ||
+ is.na(radius) || is.nan(radius) || radius <= 0 ||
+ is.na(xc) || is.na(yc)) {
+ return(NA)
+ }
+
+ if (!all(c("X", "Y") %in% names(slice_points))) {
+ stop("`slice_points` must contain columns X and Y.", call. = FALSE)
+ }
+
+ # Buffer around the fitted stem surface.
+ # Default behaviour:
+ # inner_buffer = max(0.06 m, 0.5 * radius)
+ inner_buffer <- max(min_inner_buffer, inner_buffer_fraction * radius)
+
+ inner_radius <- radius - inner_buffer
+
+ if (inner_radius <= 0) {
+ return(NA)
+ }
+
+ dx <- slice_points$X - xc
+ dy <- slice_points$Y - yc
+ distances <- sqrt(dx^2 + dy^2)
+
+ !any(distances < inner_radius)
+}
+
+#' Check whether all slice points fall inside the fitted stem donut
+#'
+#' Internal helper used as a quality-control metric for fitted diameter circles.
+#' The function checks whether all slice points fall within the radial donut
+#' around the fitted circle, defined as radius +/- arc_tolerance.
+#'
+#' @param slice_points A data.frame containing slice points with columns X and Y.
+#' @param radius Numeric. Radius of the fitted circle, in metres.
+#' @param xc Numeric. X-coordinate of the fitted circle centre.
+#' @param yc Numeric. Y-coordinate of the fitted circle centre.
+#' @param arc_tolerance Numeric. Radial tolerance, in metres, around the fitted
+#' circle.
+#'
+#' @return Logical. TRUE if all points fall within the donut, FALSE otherwise,
+#' and NA if the check cannot be performed.
+#'
+#' @noRd
+all_points_in_donut <- function(slice_points,
+ radius,
+ xc,
+ yc,
+ arc_tolerance = 0.05) {
+ if (is.null(slice_points) || nrow(slice_points) == 0 ||
+ is.na(radius) || is.nan(radius) || radius <= 0 ||
+ is.na(xc) || is.na(yc)) {
+ return(NA)
+ }
+
+ if (!all(c("X", "Y") %in% names(slice_points))) {
+ stop("`slice_points` must contain columns X and Y.", call. = FALSE)
+ }
+
+ dx <- slice_points$X - xc
+ dy <- slice_points$Y - yc
+ distances <- sqrt(dx^2 + dy^2)
+
+ all(distances >= radius - arc_tolerance &
+ distances <= radius + arc_tolerance)
+}
+
#' Diameter at certain height point cloud
#'
#' Returns the diameter at a certain height of a tree measured from a tree point
@@ -307,7 +535,7 @@ f <- function(c, x, y) {
#' @param slice_height Numeric value (default = 1.3) that determines the height
#' above the lowest point of the point cloud at which the diameter is
#' measured.
-#' @param slice_thickness Numeric value (default = 0.6) that determines the
+#' @param slice_thickness Numeric value (default = 0.06) that determines the
#' thickness of the slice which is used to measure the diameter.
#' @param functional Logical (default=FALSE), indicates if the functional
#' diameter should be calculated.
@@ -322,6 +550,24 @@ f <- function(c, x, y) {
#' is provided.
#' @param plot Logical (default=FALSE), indicates if the optimized circle
#' fitting is plotted.
+#' @param how Method used to summarise point-to-centre radii when estimating
+#' slice diameter. Use \code{"mean"} for the original ITSMe behaviour,
+#' \code{"median"} for the median radius, or a numeric value such as
+#' \code{10} to trim 5 percent of radii on each side before taking the mean.
+#' @param arc_min_length_cm Optional numeric. Minimum arc length, in
+#' centimetres, represented by one angular sector when calculating arc
+#' coverage. If supplied, this is converted to degrees based on the fitted
+#' radius.
+#' @param arc_min_angle Numeric. Minimum angular sector width in degrees used
+#' to calculate arc coverage. Default is 18, corresponding to 20 sectors.
+#' @param arc_tolerance Numeric. Radial tolerance, in metres, around the fitted
+#' circle. Points within radius +/- arc_tolerance are counted as supporting
+#' the fitted circle when calculating arc coverage.
+#' @param min_inner_buffer Numeric. Minimum buffer distance, in metres, excluded
+#' from the fitted radius before checking whether the inner circle is empty.
+#' @param inner_buffer_fraction Numeric. Fraction of the fitted radius used as
+#' buffer before checking whether the inner circle is empty. The effective
+#' buffer is \code{max(min_inner_buffer, inner_buffer_fraction * radius)}.
#' @param plotcolors list of four colors for plotting. Only relevant when plot =
#' TRUE. The stem points, fitted circle, the concave hull and the estimated
#' center are colored by the first, second, third and fourth element of this
@@ -331,6 +577,12 @@ f <- function(c, x, y) {
#' residual between circle fit and the points, the center of the circle fit,
#' and the functional diameter calculated from the concave hull fitting. Also
#' optionally (plot=TRUE) plots the circle fitting on the horizontal slice.
+#' The list also contains \code{arc_coverage}, a quality-control metric between
+#' 0 and 1 indicating the proportion of angular sectors around the fitted circle
+#' that contain at least one nearby point.
+#' The list also contains \code{inner_circle_empty}, a logical quality-control
+#' metric indicating whether the checked inner part of the fitted circle contains
+#' no slice points.
#'
#' @export
#'
@@ -343,8 +595,9 @@ f <- function(c, x, y) {
#' output <- diameter_slice_pc(pc = pc_tree, plot = TRUE)
#' diameter <- output$diameter
#' residual <- output$R2
-#' center <- out$center
+#' center <- output$center
#' }
+
diameter_slice_pc <-
function(pc,
slice_height = 0.1,
@@ -354,7 +607,14 @@ diameter_slice_pc <-
dtm = NA,
r = 5,
plot = FALSE,
+ how = "median",
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
plotcolors = c("#000000", "#1c027a", "#08aa7c", "#fac87f")) {
+
h_list <- tree_height_pc(pc = pc, dtm = dtm, r = r)
lowest_point <- h_list$lp
if (max(pc$Z) - lowest_point > slice_height) {
@@ -392,9 +652,36 @@ diameter_slice_pc <-
x_c <- center_estimate$par[1]
y_c <- center_estimate$par[2]
Ri <- calc_r(x_slice, y_slice, x_c, y_c)
- R <- mean(Ri) # radius (DBH/2)
+ R <- get_radius(Ri, how = how)
residu <- sum((Ri - R) ** 2) / length(Ri) # average residual
diam <- 2 * R
+
+ arc_cov <- arc_coverage(
+ slice_points = xy_slice,
+ radius = R,
+ xc = x_c,
+ yc = y_c,
+ arc_min_length_cm = arc_min_length_cm,
+ arc_min_angle = arc_min_angle,
+ arc_tolerance = arc_tolerance
+ )
+
+ inner_empty <- inner_circle_empty(
+ slice_points = xy_slice,
+ radius = R,
+ xc = x_c,
+ yc = y_c,
+ min_inner_buffer = min_inner_buffer,
+ inner_buffer_fraction = inner_buffer_fraction
+ )
+ all_in_donut <- all_points_in_donut(
+ slice_points = xy_slice,
+ radius = R,
+ xc = x_c,
+ yc = y_c,
+ arc_tolerance = arc_tolerance
+ )
+
if (functional) {
points <-
sf::st_as_sf(unique(xy_slice), coords = c("X", "Y"))
@@ -411,7 +698,12 @@ diameter_slice_pc <-
"R2" = NaN,
"center" = NaN,
"fdiameter" = NaN,
- "hull" = NaN
+ "hull" = NaN,
+ "arc_coverage" = NA_real_,
+ "inner_circle_empty" = NA,
+ "all_points_in_donut" = NA
+
+
))
}
} else {
@@ -420,12 +712,20 @@ diameter_slice_pc <-
"R2" = NaN,
"center" = NaN,
"fdiameter" = NaN,
- "hull" = NaN
+ "hull" = NaN,
+ "arc_coverage" = NA_real_,
+ "inner_circle_empty" = NA,
+ "all_points_in_donut" = NA
+
))
}
if (!is.nan(R)) {
if (R > 1.5) {
R <- diam <- center_estimate <- NaN
+ arc_cov <- NA_real_
+ inner_empty <- NA
+ all_in_donut <- NA
+
}
}
if (plot) {
@@ -448,14 +748,14 @@ diameter_slice_pc <-
ggplot2::ggtitle(
paste0(
"diameter at ", as.character(round(slice_height, 2)),
- " m = ", as.character(round(diam*100)),
+ " m = ", as.character(round(diam*100, 1)),
" cm ",
"(R2 = ",
as.character(round(residu * 100, 2)),
" cm)",
"\n",
"fDAB = ",
- as.character(round(fdiam*100)),
+ as.character(round(fdiam*100, 1)),
" cm",
sep = ""
)
@@ -476,12 +776,12 @@ diameter_slice_pc <-
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
} else {
plotDIAM <- plotDIAM +
@@ -489,7 +789,7 @@ diameter_slice_pc <-
ggplot2::ggtitle(
paste0(
"diameter at ", as.character(round(slice_height, 2)),
- " m = ", as.character(round(diam*100)),
+ " m = ", as.character(round(diam*100,1)),
" cm ",
"(R2 = ",
as.character(round(residu * 100, 2)),
@@ -510,12 +810,12 @@ diameter_slice_pc <-
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
}
if (!is.nan(R)) {
@@ -557,12 +857,12 @@ diameter_slice_pc <-
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
} else {
plotDIAM <- plotDIAM +
@@ -583,12 +883,12 @@ diameter_slice_pc <-
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
}
}
@@ -600,6 +900,9 @@ diameter_slice_pc <-
"center" = center_estimate,
"fdiameter" = fdiam,
"hull" = hull,
+ "arc_coverage" = arc_cov,
+ "inner_circle_empty" = inner_empty,
+ "all_points_in_donut" = all_in_donut,
"plot" = plotDIAM
)
)
@@ -610,7 +913,11 @@ diameter_slice_pc <-
"R2" = residu,
"center" = center_estimate,
"fdiameter" = fdiam,
- "hull" = hull
+ "hull" = hull,
+ "arc_coverage" = arc_cov,
+ "inner_circle_empty" = inner_empty,
+ "all_points_in_donut" = all_in_donut
+
)
)
}
@@ -620,7 +927,11 @@ diameter_slice_pc <-
"R2" = NaN,
"center" = NaN,
"fdiameter" = NaN,
- "hull" = NaN
+ "hull" = NaN,
+ "arc_coverage" = NA_real_,
+ "inner_circle_empty" = NA,
+ "all_points_in_donut" = NA
+
))
}
}
@@ -653,6 +964,10 @@ diameter_slice_pc <-
#' @param r Numeric value (default=5) r which determines the range taken for the
#' dtm. Should be at least the resolution of the dtm. Only relevant when a dtm
#' is provided.
+#' @param how Method used to summarise point-to-centre radii when estimating
+#' slice diameter. Use \code{"mean"} for the original ITSMe behaviour,
+#' \code{"median"} for the median radius, or a numeric value such as
+#' \code{10} to trim 5 percent of radii on each side before taking the mean.
#'
#' @return Data.frame with the lower trunk point cloud (part of the trunk below
#' 1.5 m).
@@ -670,18 +985,21 @@ extract_lower_trunk_pc <-
slice_thickness = 0.08,
concavity = 4,
dtm = NA,
- r = 5) {
+ r = 5,
+ how = "median") {
initial_height <- 0.15
h_list <- tree_height_pc(pc = pc, dtm = dtm, r = r)
lowest_point <- h_list$lp
dh <- slice_thickness
+
diam <- diameter_slice_pc(
pc = pc,
slice_height = initial_height,
slice_thickness = slice_thickness,
concavity = concavity,
dtm = dtm,
- r = r
+ r = r,
+ how = how
)
a <- 0.02
d <- diam$diameter + a
@@ -738,7 +1056,8 @@ extract_lower_trunk_pc <-
slice_thickness = slice_thickness * 2,
concavity = concavity,
dtm = dtm,
- r = r
+ r = r,
+ how = how
)
if (!is.nan(diam$diameter) & diam$diameter < 2) {
if (diam$R2 > 0.002 * diam$diameter) {
@@ -753,7 +1072,8 @@ extract_lower_trunk_pc <-
slice_thickness = slice_thickness * 2,
concavity = concavity,
dtm = dtm,
- r = r
+ r = r,
+ how = how
)
if (!is.nan(diam2$diameter)) {
trunk_slice <- trunk_slice_b
@@ -782,7 +1102,7 @@ extract_lower_trunk_pc <-
#' this the area of the concave hull with (concavity 4) is determined on the
#' slice. From this area the diameter is determined as the diameter of a circle
#' with this area. In case there are branches or foliage at this height, the
-#' lower trunk is extracted using \code{\link{extract_lower_trunk_pc}}. Wether
+#' lower trunk is extracted using \code{\link{extract_lower_trunk_pc}}. Whether
#' this is the case is determined using the thresholdR2 parameter. When the
#' bottom of the point cloud is incomplete or obstructed you can choose to add a
#' digital terrain model as an input which is used to estimate lowest point of
@@ -810,6 +1130,25 @@ extract_lower_trunk_pc <-
#' @param r Numeric value (default=5) r which determines the range taken for the
#' dtm. Should be at least the resolution of the dtm. Only relevant when a dtm
#' is provided.
+#' @param how Method used to summarise point-to-centre radii when estimating
+#' DBH. Use \code{"mean"} for the original ITSMe behaviour, \code{"median"}
+#' for the median radius (default), or a numeric value such as \code{10} to trim
+#' 5 percent of radii on each side before taking the mean.
+#' @param arc_min_length_cm Optional numeric. Minimum arc length, in
+#' centimetres, represented by one angular sector when calculating arc
+#' coverage for the final DBH circle.
+#' @param arc_min_angle Numeric. Minimum angular sector width in degrees used
+#' to calculate arc coverage for the final DBH circle. Default is 18,
+#' corresponding to 20 sectors.
+#' @param arc_tolerance Numeric. Radial tolerance, in metres, around the fitted
+#' circle. Points within radius +/- arc_tolerance are counted as supporting
+#' the fitted circle when calculating arc coverage.
+#' @param min_inner_buffer Numeric. Minimum buffer distance, in metres, excluded
+#' from the fitted DBH radius before checking whether the inner circle is
+#' empty.
+#' @param inner_buffer_fraction Numeric. Fraction of the fitted DBH radius used
+#' as buffer before checking whether the inner circle is empty. The effective
+#' buffer is \code{max(min_inner_buffer, inner_buffer_fraction * radius)}.
#' @param plot Logical (default=FALSE), indicates if the optimised circle
#' fitting is plotted.
#' @param plotcolors list of four colors for plotting. Only relevant when plot
@@ -821,6 +1160,12 @@ extract_lower_trunk_pc <-
#' the fitting, the estimated center of the circle fit, and the functional
#' diameter at breast height. Also optionally (plot=TRUE) plots the circle
#' fitting on the horizontal slice which is then included in the list output.
+#' The list also contains \code{arc_coverage}, a quality-control metric between
+#' 0 and 1 indicating the proportion of angular sectors around the fitted DBH
+#' circle that contain at least one nearby point.
+#' The list also contains \code{inner_circle_empty}, a logical quality-control
+#' metric indicating whether the checked inner part of the fitted DBH circle
+#' contains no slice points.
#'
#' @export
#'
@@ -833,6 +1178,7 @@ extract_lower_trunk_pc <-
#' output <- dbh_pc(pc = pc_tree, plot = TRUE)
#' dbh <- output$dbh
#' }
+
dbh_pc <- function(pc,
thresholdR2 = 0.001,
slice_thickness = 0.06,
@@ -840,6 +1186,12 @@ dbh_pc <- function(pc,
concavity = 4,
dtm = NA,
r = 5,
+ how = "median", #'mean": original ITSMe behaviour
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
plot = FALSE,
plotcolors = c("#000000", "#1c027a", "#08aa7c", "#fac87f")) {
h_list <- tree_height_pc(pc = pc, dtm = dtm, r = r)
@@ -851,7 +1203,8 @@ dbh_pc <- function(pc,
functional = functional,
concavity = concavity,
dtm = dtm,
- r = r
+ r = r,
+ how = how
)
if (is.nan(out_015$diameter)) {
out_015$diameter <- 2
@@ -863,7 +1216,13 @@ dbh_pc <- function(pc,
functional = functional,
concavity = concavity,
dtm = dtm,
- r = r
+ r = r,
+ how = how,
+ arc_min_length_cm = arc_min_length_cm,
+ arc_min_angle = arc_min_angle,
+ arc_tolerance = arc_tolerance,
+ min_inner_buffer = min_inner_buffer,
+ inner_buffer_fraction = inner_buffer_fraction
)
if (is.nan(out_130$diameter)) {
trunk_pc <- tryCatch({
@@ -871,7 +1230,8 @@ dbh_pc <- function(pc,
pc = pc,
slice_thickness = slice_thickness + 0.02,
dtm = dtm,
- r = r
+ r = r,
+ how = how
)
}, error = function(cond) {
return(pc)
@@ -883,10 +1243,21 @@ dbh_pc <- function(pc,
functional = functional,
concavity = concavity,
dtm = dtm,
- r = r
+ r = r,
+ how = how,
+ arc_min_length_cm = arc_min_length_cm,
+ arc_min_angle = arc_min_angle,
+ arc_tolerance = arc_tolerance,
+ min_inner_buffer = min_inner_buffer,
+ inner_buffer_fraction = inner_buffer_fraction
)
} else {
- if (out_015$diameter < out_130$diameter |
+ skip_low_slice_check <- isTRUE(out_130$all_points_in_donut) &&
+ !is.na(out_130$arc_coverage) &&
+ out_130$arc_coverage == 1 &&
+ isTRUE(out_130$inner_circle_empty)
+
+ if ((!skip_low_slice_check & out_015$diameter < out_130$diameter) |
out_130$R2 > thresholdR2 * out_130$diameter |
out_130$diameter > 2) {
trunk_pc <- tryCatch({
@@ -894,7 +1265,8 @@ dbh_pc <- function(pc,
pc = pc,
slice_thickness = slice_thickness + 0.02,
dtm = dtm,
- r = r
+ r = r,
+ how = how
)
}, error = function(cond) {
return(pc)
@@ -906,7 +1278,13 @@ dbh_pc <- function(pc,
functional = functional,
concavity = concavity,
dtm = dtm,
- r = r
+ r = r,
+ how = how,
+ arc_min_length_cm = arc_min_length_cm,
+ arc_min_angle = arc_min_angle,
+ arc_tolerance = arc_tolerance,
+ min_inner_buffer = min_inner_buffer,
+ inner_buffer_fraction = inner_buffer_fraction
)
}
}
@@ -936,12 +1314,12 @@ dbh_pc <- function(pc,
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
} else {
pc_dbh <- pc[(pc$Z > lowest_point + 1.3 - slice_thickness / 2) &
@@ -952,7 +1330,70 @@ dbh_pc <- function(pc,
y0 = out_130$center[[1]][2],
r = out_130$diameter / 2
)
+
+ radius <- out_130$diameter / 2
+
+ donut_outer_radius <- radius + arc_tolerance
+ donut_inner_radius <- max(0, radius - arc_tolerance)
+
+ inner_buffer <- max(min_inner_buffer, inner_buffer_fraction * radius)
+ inner_radius <- radius - inner_buffer
+
+ data_donut_outer <- data.frame(
+ x0 = out_130$center[[1]][1],
+ y0 = out_130$center[[1]][2],
+ r = donut_outer_radius
+ )
+
+ data_donut_inner <- data.frame(
+ x0 = out_130$center[[1]][1],
+ y0 = out_130$center[[1]][2],
+ r = donut_inner_radius
+ )
+
+ data_inner_buffer <- data.frame(
+ x0 = out_130$center[[1]][1],
+ y0 = out_130$center[[1]][2],
+ r = inner_radius
+ )
+
plotDBH <- ggplot2::ggplot() +
+ #ggplot2::coord_fixed(ratio = 1) +
+
+ # --- QC background layers ---
+
+ # optional outlines for the QC zones
+ ggforce::geom_circle(
+ data = data_donut_outer,
+ ggplot2::aes(x0 = x0, y0 = y0, r = r, color = "arc coverage zone"),
+ inherit.aes = FALSE,
+ linetype = "solid",
+ linewidth = .5,
+ fill = NA,
+ show.legend = TRUE
+ ) +
+
+ ggforce::geom_circle(
+ data = data_donut_inner,
+ ggplot2::aes(x0 = x0, y0 = y0, r = r, color = "arc coverage zone"),
+ inherit.aes = FALSE,
+ linetype = "solid",
+ linewidth = .5,
+ fill = NA,
+ show.legend = FALSE
+ ) +
+ ggforce::geom_circle(
+ data = data_inner_buffer,
+ ggplot2::aes(x0 = x0, y0 = y0, r = r, color = "inner empty zone"),
+ inherit.aes = FALSE,
+ linetype = "solid",
+ linewidth = .5,
+ fill = NA,
+ show.legend = TRUE
+ ) +
+
+ # --- actual data ---
+
ggplot2::geom_point(
data = pc_dbh,
ggplot2::aes(X, Y, color = "points stem slice"),
@@ -981,19 +1422,19 @@ dbh_pc <- function(pc,
),
inherit.aes = FALSE,
show.legend = TRUE,
- size = 1
+ linewidth = 1
) +
ggplot2::ggtitle(
paste(
"DBH = ",
- as.character(round(out_130$diameter*100)),
+ as.character(round(out_130$diameter*100,1)),
" cm ",
"(R2 = ",
as.character(round(out_130$R2 * 100, 2)),
- " cm)",
+ " cm);",
"\n",
"fDBH = ",
- as.character(round(out_130$fdiameter*100)),
+ as.character(round(out_130$fdiameter*100,1)),
" cm",
sep = ""
)
@@ -1004,24 +1445,28 @@ dbh_pc <- function(pc,
"points stem slice" = plotcolors[1],
"concave hull" = plotcolors[3],
"estimated center" = plotcolors[4],
- "fitted circle" = plotcolors[2]
+ "fitted circle" = plotcolors[2],
+ "arc coverage zone" = "grey55",
+ "inner empty zone" = "grey85"
),
- guide = ggplot2::guide_legend(override.aes =
- list(
- linetype = c(1, 0, 1, 0),
- shape = c(NA, 16, NA, 16),
- size = c(1, 2, 1, 2)
- ))
+ guide = ggplot2::guide_legend(
+ override.aes = list(
+ linetype = c(0, 1, 0, 1, 1, 1),
+ shape = c(16, NA, 16, NA, NA, NA),
+ size = c(2, 1, 2, 1, 0.5, 0.5)
+ )
+ )
) +
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title = ggplot2::element_blank(),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
- axis.ticks.length = ggplot2::unit(0.2, "cm"))
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
+ axis.ticks.length = ggplot2::unit(0.2, "cm"),
+ legend.position = "right")
} else {
plotDBH <- plotDBH +
@@ -1041,42 +1486,53 @@ dbh_pc <- function(pc,
),
inherit.aes = FALSE,
show.legend = TRUE,
- size = 1
+ linewidth = 1
) +
ggplot2::ggtitle(
- paste(
- "DBH = ",
- as.character(round(out_130$diameter*100)),
- " cm, ",
- "(R2 = ",
- as.character(round(out_130$R2 * 100, 2)),
- " cm)",
- sep = ""
+ paste0(
+ "DBH = ", round(out_130$diameter * 100, 2), " cm ",
+ "(R2 = ", round(out_130$R2 * 100, 2), " cm)",
+ "\n",
+ "arc coverage = ", round(out_130$arc_coverage, 2),
+ "; inner empty = ", out_130$inner_circle_empty
)
) +
ggplot2::scale_color_manual(
name = "",
+ breaks = c(
+ "points stem slice",
+ "estimated center",
+ "fitted circle",
+ "arc coverage zone",
+ "inner empty zone"
+ ),
values = c(
"points stem slice" = plotcolors[1],
"estimated center" = plotcolors[4],
- "fitted circle" = plotcolors[2]
+ "fitted circle" = plotcolors[2],
+ "arc coverage zone" = "grey55",
+ "inner empty zone" = "grey85"
),
- guide = ggplot2::guide_legend(override.aes =
- list(
- linetype = c(0, 1, 0),
- shape = c(16, NA, 16),
- size = c(2, 1, 2)
- ))
+ guide = ggplot2::guide_legend(
+ override.aes = list(
+ shape = c(16, 16, NA, NA, NA),
+ linetype = c(0, 0, 1, 1, 1),
+ size = c(2, 2, NA, NA, NA),
+ linewidth = c(NA, NA, 1, 0.5, 0.5),
+ fill = rep(NA, 5)
+ )
+ )
) +
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title = ggplot2::element_blank(),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
- axis.ticks.length = ggplot2::unit(0.2, "cm"))
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
+ axis.ticks.length = ggplot2::unit(0.2, "cm"),
+ legend.position = "right")
}
}
print(plotDBH)
@@ -1086,6 +1542,8 @@ dbh_pc <- function(pc,
"R2" = out_130$R2,
"center" = out_130$center,
"fdbh" = out_130$fdiameter,
+ "arc_coverage" = out_130$arc_coverage,
+ "inner_circle_empty" = out_130$inner_circle_empty,
"plot" = plotDBH
)
)
@@ -1094,7 +1552,10 @@ dbh_pc <- function(pc,
"dbh" = out_130$diameter,
"R2" = out_130$R2,
"center" = out_130$center,
- "fdbh" = out_130$fdiameter
+ "fdbh" = out_130$fdiameter,
+ "arc_coverage" = out_130$arc_coverage,
+ "inner_circle_empty" = out_130$inner_circle_empty
+
))
}
}
@@ -1284,7 +1745,7 @@ dab_pc <-
),
inherit.aes = FALSE,
show.legend = TRUE,
- size = 1
+ linewidth = 1
) +
ggplot2::ggtitle(
paste0(
@@ -1320,12 +1781,12 @@ dab_pc <-
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
} else {
plotDAB <- plotDAB +
@@ -1345,7 +1806,7 @@ dab_pc <-
),
inherit.aes = FALSE,
show.legend = TRUE,
- size = 1
+ linewidth = 1
) +
ggplot2::ggtitle(
paste("DAB at ", as.character(round(slice_height, 2)),
@@ -1373,12 +1834,12 @@ dab_pc <-
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
}
} else {
@@ -1411,7 +1872,7 @@ dab_pc <-
),
inherit.aes = FALSE,
show.legend = TRUE,
- size = 1
+ linewidth = 1
) +
ggplot2::ggtitle(
paste(
@@ -1446,12 +1907,12 @@ dab_pc <-
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
} else {
plotDAB <- plotDAB +
@@ -1471,7 +1932,7 @@ dab_pc <-
),
inherit.aes = FALSE,
show.legend = TRUE,
- size = 1
+ linewidth = 1
) +
ggplot2::ggtitle(
paste(
@@ -1501,12 +1962,12 @@ dab_pc <-
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
}
}
@@ -1574,6 +2035,30 @@ dab_pc <-
#' @param r Numeric value (default=5) r which determines the range taken for the
#' dtm. Should be at least the resolution of the dtm. Only relevant when a dtm
#' is provided.
+#' @param how Method used to summarise point-to-centre radii when estimating
+#' DBH with \code{\link{dbh_pc}}. Use \code{"mean"} for the original ITSMe
+#' behaviour, \code{"median"} for the median radius, or a numeric value such
+#' as \code{10} to trim 5 percent of radii on each side before taking the
+#' mean. Only relevant when buttress == FALSE.
+#' @param arc_min_length_cm Optional numeric. Minimum arc length, in centimetres,
+#' represented by one angular sector when calculating arc coverage with
+#' \code{\link{dbh_pc}}. If supplied, this is converted to degrees based on
+#' the fitted radius. Only relevant when buttress == FALSE.
+#' @param arc_min_angle Numeric. Minimum angular sector width in degrees used
+#' to calculate arc coverage with \code{\link{dbh_pc}}. Default is 18,
+#' corresponding to 20 sectors. Only relevant when buttress == FALSE.
+#' @param arc_tolerance Numeric. Radial tolerance, in metres, around the fitted
+#' DBH circle. Points within radius +/- arc_tolerance are counted as
+#' supporting the fitted circle when calculating arc coverage with
+#' \code{\link{dbh_pc}}. Only relevant when buttress == FALSE.
+#' @param min_inner_buffer Numeric. Minimum buffer distance, in metres, excluded
+#' from the fitted DBH radius before checking whether the inner circle is
+#' empty with \code{\link{dbh_pc}}. Only relevant when buttress == FALSE.
+#' @param inner_buffer_fraction Numeric. Fraction of the fitted DBH radius used
+#' as buffer before checking whether the inner circle is empty with
+#' \code{\link{dbh_pc}}. The effective buffer is
+#' \code{max(min_inner_buffer, inner_buffer_fraction * radius)}. Only relevant
+#' when buttress == FALSE.
#' @param plot Logical (default=FALSE), indicates if the classified tree is
#' plotted.
#' @param plotcolors list of two colors for plotting. Only relevant when plot =
@@ -1614,6 +2099,12 @@ classify_crown_pc <-
concavity = 4,
dtm = NA,
r = 5,
+ how = "median",
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
plot = FALSE,
plotcolors = c("#08aa7c", "#fac87f")) {
h_list <- tree_height_pc(pc = pc, dtm = dtm, r = r)
@@ -1634,13 +2125,20 @@ classify_crown_pc <-
dab <- out$dab
} else {
out <- dbh_pc(
- pc,
- thresholdR2,
- slice_thickness,
- dtm = dtm,
+ pc = pc,
+ thresholdR2 = thresholdR2,
+ slice_thickness = slice_thickness,
functional = FALSE,
concavity = concavity,
- r = r
+ dtm = dtm,
+ r = r,
+ how = how,
+ arc_min_length_cm = arc_min_length_cm,
+ arc_min_angle = arc_min_angle,
+ arc_tolerance = arc_tolerance,
+ min_inner_buffer = min_inner_buffer,
+ inner_buffer_fraction = inner_buffer_fraction,
+ plot = FALSE
)
dab <- out$dbh
}
@@ -1793,7 +2291,7 @@ classify_crown_pc <-
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
@@ -1820,7 +2318,7 @@ classify_crown_pc <-
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
axis.text.y = ggplot2::element_blank(),
@@ -1859,7 +2357,7 @@ classify_crown_pc <-
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
@@ -1886,7 +2384,7 @@ classify_crown_pc <-
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
axis.text.y = ggplot2::element_blank(),
@@ -1923,7 +2421,7 @@ classify_crown_pc <-
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
@@ -1950,7 +2448,7 @@ classify_crown_pc <-
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
axis.text.y = ggplot2::element_blank(),
@@ -2006,11 +2504,11 @@ classify_crown_pc <-
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"),
axis.text.x = ggplot2::element_blank(),
axis.ticks.x = ggplot2::element_blank(),
@@ -2035,11 +2533,11 @@ classify_crown_pc <-
panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
title = ggplot2::element_text(size=12, face = 'bold'),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title.y = ggplot2::element_text(size=14, color = "black"),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.title.x = ggplot2::element_text(size=14, color = "black"),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"),
axis.text.y = ggplot2::element_blank(),
axis.ticks.y = ggplot2::element_blank(),
@@ -2137,17 +2635,17 @@ normalize_pc <- function(pc, dtm = NA, r = 5) {
#' \dontrun{
#' # Read tree point cloud and calculate the projected tree area
#' pc_tree <- read_tree_pc(PC_path = "path/to/point_cloud.txt")
-#' pta <- projected_crown_area_pc(pc = pc_tree)
+#' pa <- projected_area_pc(pc = pc_tree)
#' # and plot the concave hull fitting
-#' output <- projected_crown_area_pc(pc = pc_tree, plot = TRUE)
-#' pca <- output$pca
+#' output <- projected_area_pc(pc = pc_tree, plot = TRUE)
+#' pa <- output$pa
#' # classify the tree point cloud and calculate the projected crown area
#' crown_pc <- classify_crown_pc(
#' pc, thresholdbranch, minheight, buttress,
#' thresholdR2, thresholdbuttress,
#' maxbuttressheight, FALSE
#' )
-#' pca <- projected_crown_area_pc(pc = crown_pc$crownpoints)
+#' pca <- projected_area_pc(pc = crown_pc$crownpoints)
#' }
projected_area_pc <- function(pc,
concavity = 2,
@@ -2186,11 +2684,11 @@ projected_area_pc <- function(pc,
) +
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = 'gray90'),
panel.background = ggplot2::element_blank(),
- axis.line = ggplot2::element_line(size = 0.8, color = "black"),
+ axis.line = ggplot2::element_line(linewidth = 0.8, color = "black"),
axis.title = ggplot2::element_blank(),
axis.text = ggplot2::element_text(size=14, color = "black"),
axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1),
- axis.ticks = ggplot2::element_line(size=0.8, color = "black"),
+ axis.ticks = ggplot2::element_line(linewidth=0.8, color = "black"),
axis.ticks.length = ggplot2::unit(0.2, "cm"))
print(plotPA)
return(list("pa" = pa, "plot" = plotPA))
diff --git a/R/summary_metrics.R b/R/summary_metrics.R
index 3ad1318..272e208 100644
--- a/R/summary_metrics.R
+++ b/R/summary_metrics.R
@@ -56,6 +56,30 @@
#' \code{\link[concaveman]{concaveman}}. This concavity value is used in the
#' functions \code{\link{diameter_slice_pc}}, \code{\link{dbh_pc}},
#' \code{\link{dab_pc}}, and \code{\link{classify_crown_pc}}.
+#' @param how Method used to summarise point-to-centre radii when estimating
+#' DBH with \code{\link{dbh_pc}}. Use \code{"mean"} for the original ITSMe
+#' behaviour, \code{"median"} for the median radius, or a numeric value such
+#' as \code{10} to trim 5 percent of radii on each side before taking the
+#' mean. Only relevant when buttress == FALSE.
+#' @param arc_min_length_cm Optional numeric. Minimum arc length, in centimetres,
+#' represented by one angular sector when calculating arc coverage with
+#' \code{\link{dbh_pc}}. If supplied, this is converted to degrees based on
+#' the fitted radius. Only relevant when buttress == FALSE.
+#' @param arc_min_angle Numeric. Minimum angular sector width in degrees used
+#' to calculate arc coverage with \code{\link{dbh_pc}}. Default is 18,
+#' corresponding to 20 sectors. Only relevant when buttress == FALSE.
+#' @param arc_tolerance Numeric. Radial tolerance, in metres, around the fitted
+#' DBH circle. Points within radius +/- arc_tolerance are counted as
+#' supporting the fitted circle when calculating arc coverage with
+#' \code{\link{dbh_pc}}. Only relevant when buttress == FALSE.
+#' @param min_inner_buffer Numeric. Minimum buffer distance, in metres, excluded
+#' from the fitted DBH radius before checking whether the inner circle is
+#' empty with \code{\link{dbh_pc}}. Only relevant when buttress == FALSE.
+#' @param inner_buffer_fraction Numeric. Fraction of the fitted DBH radius used
+#' as buffer before checking whether the inner circle is empty with
+#' \code{\link{dbh_pc}}. The effective buffer is
+#' \code{max(min_inner_buffer, inner_buffer_fraction * radius)}. Only relevant
+#' when buttress == FALSE.
#' @param OUT_path A character with name of the output folder where the summary
#' figures should be saved or logical (default=FALSE) in this case no figures
#' are saved.
@@ -93,6 +117,9 @@
#' crown = TRUE, minheight = 4, buttress = TRUE
#' )
#' }
+#'
+#'
+
summary_basic_pointcloud_metrics_pertree <-
function(PC_path,
metrics = c("tree position",
@@ -115,6 +142,12 @@ summary_basic_pointcloud_metrics_pertree <-
maxbuttressheight = 7,
functional = TRUE,
concavity_fdiameter = 4,
+ how = "median",
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
OUT_path = FALSE,
overwrite = FALSE,
plot = FALSE,
@@ -122,6 +155,11 @@ summary_basic_pointcloud_metrics_pertree <-
#print which tree is processing and initiate data frame
print(paste("processing ", basename(PC_path)))
+ safe_extract <- function(x, name, default = NA) {
+ if (is.null(x) || is.null(x[[name]])) return(default)
+ x[[name]]
+ }
+
#if the output file already exists
output_filename <- paste0(OUT_path, "summary_basic_metrics.csv")
if (file.exists(output_filename) & overwrite == FALSE) {
@@ -178,16 +216,20 @@ summary_basic_pointcloud_metrics_pertree <-
#calculate stem diameter
if ("stem diameter" %in% metrics) {
print("calculating stem diameter")
- if (!("tree height" %in% metrics)){
- h_out <-
- tree_height_pc(
- pc = pc,
- dtm = dtm,
- r = r
- )
+
+ if (!("tree height" %in% metrics)) {
+ h_out <- tree_height_pc(
+ pc = pc,
+ dtm = dtm,
+ r = r
+ )
}
+
+ diameter_out <- NULL
+
if (buttress & (h_out$h > h_cutoff)) {
- dab_out <- tryCatch({
+
+ diameter_out <- tryCatch({
dab_pc(
pc = pc,
thresholdbuttress = thresholdbuttress,
@@ -206,49 +248,65 @@ summary_basic_pointcloud_metrics_pertree <-
"dab" = NaN,
"R2" = NaN,
"fdab" = NaN,
- "plot" = empty_plot,
- "h" = NaN
+ "h" = NaN,
+ "arc_coverage" = NA_real_,
+ "inner_circle_empty" = NA,
+ "plot" = empty_plot
))
})
- tree$stem_diameter_m <- dab <- dab_out$dab
- tree$R2 <- R2 <- dab_out$R2
- tree$functional_stem_diameter_m <- fdab <- dab_out$fdab
- tree$height_stem_diameter_m <- dab_out$h
- if (plot == TRUE) {
- d_plot <- dab_out$plot
- d_plot <- d_plot + ggplot2::theme(legend.key = ggplot2::element_blank())
- }
+
+ tree$stem_diameter_m <- dab <- diameter_out$dab
+ tree$R2 <- R2 <- diameter_out$R2
+ tree$functional_stem_diameter_m <- fdab <- diameter_out$fdab
+ tree$height_stem_diameter_m <- diameter_out$h
+
} else {
- dbh_out <- tryCatch({
- dbh_out <-
- dbh_pc(
- pc = pc,
- thresholdR2 = thresholdR2,
- slice_thickness = slice_thickness,
- functional = functional,
- concavity = concavity_fdiameter,
- dtm = dtm,
- r = r,
- plot = plot,
- plotcolors = plotcolors[c(1, 3:5)]
- )
+
+ diameter_out <- tryCatch({
+ dbh_pc(
+ pc = pc,
+ thresholdR2 = thresholdR2,
+ slice_thickness = slice_thickness,
+ functional = functional,
+ concavity = concavity_fdiameter,
+ dtm = dtm,
+ r = r,
+ how = how,
+ arc_min_length_cm = arc_min_length_cm,
+ arc_min_angle = arc_min_angle,
+ arc_tolerance = arc_tolerance,
+ min_inner_buffer = min_inner_buffer,
+ inner_buffer_fraction = inner_buffer_fraction,
+ plot = plot,
+ plotcolors = plotcolors[c(1, 3:5)]
+ )
}, error = function(cond) {
message(cond)
return(list(
"dbh" = NaN,
"R2" = NaN,
"fdbh" = NaN,
+ "arc_coverage" = NA_real_,
+ "inner_circle_empty" = NA,
"plot" = empty_plot
))
})
- tree$stem_diameter_m <- dbh <- dbh_out$dbh
- tree$R2 <- R2 <- dbh_out$R2
- tree$functional_stem_diameter_m <- fdbh <- dbh_out$fdbh
+
+ tree$stem_diameter_m <- dbh <- diameter_out$dbh
+ tree$R2 <- R2 <- diameter_out$R2
+ tree$functional_stem_diameter_m <- fdbh <- diameter_out$fdbh
tree$height_stem_diameter_m <- 1.3
- if (plot == TRUE) {
- d_plot <- dbh_out$plot
- d_plot <- d_plot + ggplot2::theme(legend.key = ggplot2::element_blank())
- }
+ }
+
+ # Always add these columns, for both DBH and DAB.
+ # For DAB they will be NA unless dab_pc() is later extended
+ # to return the same QC metrics.
+ tree$dbh_arc_coverage <- safe_extract(diameter_out, "arc_coverage", NA_real_)
+ tree$dbh_inner_circle_empty <- safe_extract(diameter_out, "inner_circle_empty", NA)
+
+ if (plot == TRUE) {
+ d_plot <- safe_extract(diameter_out, "plot", empty_plot)
+ d_plot <- d_plot + ggplot2::theme(legend.key = ggplot2::element_blank())
}
}
#perform crown classification
@@ -268,6 +326,12 @@ summary_basic_pointcloud_metrics_pertree <-
concavity = concavity_fdiameter,
dtm = dtm,
r = r,
+ how = how,
+ arc_min_length_cm = arc_min_length_cm,
+ arc_min_angle = arc_min_angle,
+ arc_tolerance = arc_tolerance,
+ min_inner_buffer = min_inner_buffer,
+ inner_buffer_fraction = inner_buffer_fraction,
plot = plot,
plotcolors = plotcolors[c(4:5)]
)
@@ -502,6 +566,30 @@ summary_basic_pointcloud_metrics_pertree <-
#' \code{\link[concaveman]{concaveman}}. This concavity value is used in the
#' functions \code{\link{diameter_slice_pc}}, \code{\link{dbh_pc}},
#' \code{\link{dab_pc}}, and \code{\link{classify_crown_pc}}.
+#' @param how Method used to summarise point-to-centre radii when estimating
+#' DBH with \code{\link{dbh_pc}}. Use \code{"mean"} for the original ITSMe
+#' behaviour, \code{"median"} for the median radius, or a numeric value such
+#' as \code{10} to trim 5 percent of radii on each side before taking the
+#' mean. Only relevant when buttress == FALSE.
+#' @param arc_min_length_cm Optional numeric. Minimum arc length, in centimetres,
+#' represented by one angular sector when calculating arc coverage with
+#' \code{\link{dbh_pc}}. If supplied, this is converted to degrees based on
+#' the fitted radius. Only relevant when buttress == FALSE.
+#' @param arc_min_angle Numeric. Minimum angular sector width in degrees used
+#' to calculate arc coverage with \code{\link{dbh_pc}}. Default is 18,
+#' corresponding to 20 sectors. Only relevant when buttress == FALSE.
+#' @param arc_tolerance Numeric. Radial tolerance, in metres, around the fitted
+#' DBH circle. Points within radius +/- arc_tolerance are counted as
+#' supporting the fitted circle when calculating arc coverage with
+#' \code{\link{dbh_pc}}. Only relevant when buttress == FALSE.
+#' @param min_inner_buffer Numeric. Minimum buffer distance, in metres, excluded
+#' from the fitted DBH radius before checking whether the inner circle is
+#' empty with \code{\link{dbh_pc}}. Only relevant when buttress == FALSE.
+#' @param inner_buffer_fraction Numeric. Fraction of the fitted DBH radius used
+#' as buffer before checking whether the inner circle is empty with
+#' \code{\link{dbh_pc}}. The effective buffer is
+#' \code{max(min_inner_buffer, inner_buffer_fraction * radius)}. Only relevant
+#' when buttress == FALSE.
#' @param OUT_path A character with name of the output file (including the path
#' to the folder), where the summary csv file should be saved or logical
#' (default=FALSE) in this case no csv file is produced.
@@ -563,6 +651,12 @@ summary_basic_pointcloud_metrics <-
maxbuttressheight = 7,
functional = TRUE,
concavity_fdiameter = 4,
+ how = "median",
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
OUT_path = FALSE,
overwrite = FALSE,
plot = FALSE,
@@ -599,6 +693,12 @@ summary_basic_pointcloud_metrics <-
"maxbuttressheight",
"functional",
"concavity_fdiameter",
+ "how",
+ "arc_min_length_cm",
+ "arc_min_angle",
+ "arc_tolerance",
+ "min_inner_buffer",
+ "inner_buffer_fraction",
"OUT_path",
"plot",
"plotcolors"
@@ -624,6 +724,12 @@ summary_basic_pointcloud_metrics <-
maxbuttressheight = maxbuttressheight,
functional = functional,
concavity_fdiameter = concavity_fdiameter,
+ how = how,
+ arc_min_length_cm = arc_min_length_cm,
+ arc_min_angle = arc_min_angle,
+ arc_tolerance = arc_tolerance,
+ min_inner_buffer = min_inner_buffer,
+ inner_buffer_fraction = inner_buffer_fraction,
OUT_path = OUT_path,
overwrite = overwrite,
plot = plot,
@@ -650,6 +756,12 @@ summary_basic_pointcloud_metrics <-
maxbuttressheight = maxbuttressheight,
functional = functional,
concavity_fdiameter = concavity_fdiameter,
+ how = how,
+ arc_min_length_cm = arc_min_length_cm,
+ arc_min_angle = arc_min_angle,
+ arc_tolerance = arc_tolerance,
+ min_inner_buffer = min_inner_buffer,
+ inner_buffer_fraction = inner_buffer_fraction,
OUT_path = OUT_path,
overwrite = overwrite,
plot = plot,
diff --git a/README.Rmd b/README.Rmd
index bf76045..8560260 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -144,6 +144,15 @@ fdab <- out_dab$fdab
+DBH fit quality control
+
+`dbh_pc()` includes options for robust DBH estimation through the `how` argument
+and returns DBH fit quality-control metrics such as `arc_coverage`and
+`inner_circle_empty`. These metrics are also included
+in `summary_basic_pointcloud_metrics()` when `"stem diameter"` is calculated.
+
+See `?dbh_pc` and `vignette("ITSMe")` for details.
+
Calculating the stem branch distance of a TreeQSM:
```{r eval = FALSE}
diff --git a/README.md b/README.md
index d5d5707..f90de2f 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,8 @@
+
+
@@ -127,12 +129,25 @@ fdab <- out_dab$fdab
```
+
+
+
+DBH fit quality control
+
+`dbh_pc()` includes options for robust DBH estimation through the `how`
+argument and returns DBH fit quality-control metrics such as
+`arc_coverage`and `inner_circle_empty`. These
+metrics are also included in `summary_basic_pointcloud_metrics()` when
+`"stem diameter"` is calculated.
+
+See `?dbh_pc` and `vignette("ITSMe")` for details.
+
Calculating the stem branch distance of a TreeQSM:
``` r
@@ -170,6 +185,7 @@ If you set the plot parameter TRUE and provide an OUT_path, this
function saves a summary figure for each tree:
+
diff --git a/man/classify_crown_pc.Rd b/man/classify_crown_pc.Rd
index 481b40e..4a1a2fb 100644
--- a/man/classify_crown_pc.Rd
+++ b/man/classify_crown_pc.Rd
@@ -16,6 +16,12 @@ classify_crown_pc(
concavity = 4,
dtm = NA,
r = 5,
+ how = "median",
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
plot = FALSE,
plotcolors = c("#08aa7c", "#fac87f")
)
@@ -65,6 +71,36 @@ point cloud it can also be read with \code{\link{read_tree_pc}}.}
dtm. Should be at least the resolution of the dtm. Only relevant when a dtm
is provided.}
+\item{how}{Method used to summarise point-to-centre radii when estimating
+DBH with \code{\link{dbh_pc}}. Use \code{"mean"} for the original ITSMe
+behaviour, \code{"median"} for the median radius, or a numeric value such
+as \code{10} to trim 5 percent of radii on each side before taking the
+mean. Only relevant when buttress == FALSE.}
+
+\item{arc_min_length_cm}{Optional numeric. Minimum arc length, in centimetres,
+represented by one angular sector when calculating arc coverage with
+\code{\link{dbh_pc}}. If supplied, this is converted to degrees based on
+the fitted radius. Only relevant when buttress == FALSE.}
+
+\item{arc_min_angle}{Numeric. Minimum angular sector width in degrees used
+to calculate arc coverage with \code{\link{dbh_pc}}. Default is 18,
+corresponding to 20 sectors. Only relevant when buttress == FALSE.}
+
+\item{arc_tolerance}{Numeric. Radial tolerance, in metres, around the fitted
+DBH circle. Points within radius +/- arc_tolerance are counted as
+supporting the fitted circle when calculating arc coverage with
+\code{\link{dbh_pc}}. Only relevant when buttress == FALSE.}
+
+\item{min_inner_buffer}{Numeric. Minimum buffer distance, in metres, excluded
+from the fitted DBH radius before checking whether the inner circle is
+empty with \code{\link{dbh_pc}}. Only relevant when buttress == FALSE.}
+
+\item{inner_buffer_fraction}{Numeric. Fraction of the fitted DBH radius used
+as buffer before checking whether the inner circle is empty with
+\code{\link{dbh_pc}}. The effective buffer is
+\code{max(min_inner_buffer, inner_buffer_fraction * radius)}. Only relevant
+when buttress == FALSE.}
+
\item{plot}{Logical (default=FALSE), indicates if the classified tree is
plotted.}
diff --git a/man/dbh_pc.Rd b/man/dbh_pc.Rd
index f71af88..5f7b179 100644
--- a/man/dbh_pc.Rd
+++ b/man/dbh_pc.Rd
@@ -12,6 +12,12 @@ dbh_pc(
concavity = 4,
dtm = NA,
r = 5,
+ how = "median",
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
plot = FALSE,
plotcolors = c("#000000", "#1c027a", "#08aa7c", "#fac87f")
)
@@ -46,6 +52,31 @@ point cloud it can also be read with \code{\link{read_tree_pc}}.}
dtm. Should be at least the resolution of the dtm. Only relevant when a dtm
is provided.}
+\item{how}{Method used to summarise point-to-centre radii when estimating
+DBH. Use \code{"mean"} for the original ITSMe behaviour, \code{"median"}
+for the median radius (default), or a numeric value such as \code{10} to trim
+5 percent of radii on each side before taking the mean.}
+
+\item{arc_min_length_cm}{Optional numeric. Minimum arc length, in
+centimetres, represented by one angular sector when calculating arc
+coverage for the final DBH circle.}
+
+\item{arc_min_angle}{Numeric. Minimum angular sector width in degrees used
+to calculate arc coverage for the final DBH circle. Default is 18,
+corresponding to 20 sectors.}
+
+\item{arc_tolerance}{Numeric. Radial tolerance, in metres, around the fitted
+circle. Points within radius +/- arc_tolerance are counted as supporting
+the fitted circle when calculating arc coverage.}
+
+\item{min_inner_buffer}{Numeric. Minimum buffer distance, in metres, excluded
+from the fitted DBH radius before checking whether the inner circle is
+empty.}
+
+\item{inner_buffer_fraction}{Numeric. Fraction of the fitted DBH radius used
+as buffer before checking whether the inner circle is empty. The effective
+buffer is \code{max(min_inner_buffer, inner_buffer_fraction * radius)}.}
+
\item{plot}{Logical (default=FALSE), indicates if the optimised circle
fitting is plotted.}
@@ -59,6 +90,12 @@ List with the diameter of the stem at breast height, the residuals on
the fitting, the estimated center of the circle fit, and the functional
diameter at breast height. Also optionally (plot=TRUE) plots the circle
fitting on the horizontal slice which is then included in the list output.
+The list also contains \code{arc_coverage}, a quality-control metric between
+0 and 1 indicating the proportion of angular sectors around the fitted DBH
+circle that contain at least one nearby point.
+The list also contains \code{inner_circle_empty}, a logical quality-control
+metric indicating whether the checked inner part of the fitted DBH circle
+contains no slice points.
}
\description{
Returns the diameter at breast height (DBH) and functional diameter at breast
@@ -74,7 +111,7 @@ breast height (fDBH) is determined using \code{\link{diameter_slice_pc}}. For
this the area of the concave hull with (concavity 4) is determined on the
slice. From this area the diameter is determined as the diameter of a circle
with this area. In case there are branches or foliage at this height, the
-lower trunk is extracted using \code{\link{extract_lower_trunk_pc}}. Wether
+lower trunk is extracted using \code{\link{extract_lower_trunk_pc}}. Whether
this is the case is determined using the thresholdR2 parameter. When the
bottom of the point cloud is incomplete or obstructed you can choose to add a
digital terrain model as an input which is used to estimate lowest point of
diff --git a/man/diameter_slice_pc.Rd b/man/diameter_slice_pc.Rd
index 5820707..a427767 100644
--- a/man/diameter_slice_pc.Rd
+++ b/man/diameter_slice_pc.Rd
@@ -13,6 +13,12 @@ diameter_slice_pc(
dtm = NA,
r = 5,
plot = FALSE,
+ how = "median",
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
plotcolors = c("#000000", "#1c027a", "#08aa7c", "#fac87f")
)
}
@@ -24,7 +30,7 @@ diameter_slice_pc(
above the lowest point of the point cloud at which the diameter is
measured.}
-\item{slice_thickness}{Numeric value (default = 0.6) that determines the
+\item{slice_thickness}{Numeric value (default = 0.06) that determines the
thickness of the slice which is used to measure the diameter.}
\item{functional}{Logical (default=FALSE), indicates if the functional
@@ -45,6 +51,30 @@ is provided.}
\item{plot}{Logical (default=FALSE), indicates if the optimized circle
fitting is plotted.}
+\item{how}{Method used to summarise point-to-centre radii when estimating
+slice diameter. Use \code{"mean"} for the original ITSMe behaviour,
+\code{"median"} for the median radius, or a numeric value such as
+\code{10} to trim 5 percent of radii on each side before taking the mean.}
+
+\item{arc_min_length_cm}{Optional numeric. Minimum arc length, in
+centimetres, represented by one angular sector when calculating arc
+coverage. If supplied, this is converted to degrees based on the fitted
+radius.}
+
+\item{arc_min_angle}{Numeric. Minimum angular sector width in degrees used
+to calculate arc coverage. Default is 18, corresponding to 20 sectors.}
+
+\item{arc_tolerance}{Numeric. Radial tolerance, in metres, around the fitted
+circle. Points within radius +/- arc_tolerance are counted as supporting
+the fitted circle when calculating arc coverage.}
+
+\item{min_inner_buffer}{Numeric. Minimum buffer distance, in metres, excluded
+from the fitted radius before checking whether the inner circle is empty.}
+
+\item{inner_buffer_fraction}{Numeric. Fraction of the fitted radius used as
+buffer before checking whether the inner circle is empty. The effective
+buffer is \code{max(min_inner_buffer, inner_buffer_fraction * radius)}.}
+
\item{plotcolors}{list of four colors for plotting. Only relevant when plot =
TRUE. The stem points, fitted circle, the concave hull and the estimated
center are colored by the first, second, third and fourth element of this
@@ -55,6 +85,12 @@ A list with the diameter at a specified height (numeric value), the
residual between circle fit and the points, the center of the circle fit,
and the functional diameter calculated from the concave hull fitting. Also
optionally (plot=TRUE) plots the circle fitting on the horizontal slice.
+The list also contains \code{arc_coverage}, a quality-control metric between
+0 and 1 indicating the proportion of angular sectors around the fitted circle
+that contain at least one nearby point.
+The list also contains \code{inner_circle_empty}, a logical quality-control
+metric indicating whether the checked inner part of the fitted circle contains
+no slice points.
}
\description{
Returns the diameter at a certain height of a tree measured from a tree point
@@ -83,6 +119,6 @@ diameter <- diameter_slice_pc(pc = pc_tree)
output <- diameter_slice_pc(pc = pc_tree, plot = TRUE)
diameter <- output$diameter
residual <- output$R2
-center <- out$center
+center <- output$center
}
}
diff --git a/man/extract_lower_trunk_pc.Rd b/man/extract_lower_trunk_pc.Rd
index a2be498..cc87199 100644
--- a/man/extract_lower_trunk_pc.Rd
+++ b/man/extract_lower_trunk_pc.Rd
@@ -9,7 +9,8 @@ extract_lower_trunk_pc(
slice_thickness = 0.08,
concavity = 4,
dtm = NA,
- r = 5
+ r = 5,
+ how = "median"
)
}
\arguments{
@@ -30,6 +31,11 @@ point cloud it can also be read with \code{\link{read_tree_pc}}.}
\item{r}{Numeric value (default=5) r which determines the range taken for the
dtm. Should be at least the resolution of the dtm. Only relevant when a dtm
is provided.}
+
+\item{how}{Method used to summarise point-to-centre radii when estimating
+slice diameter. Use \code{"mean"} for the original ITSMe behaviour,
+\code{"median"} for the median radius, or a numeric value such as
+\code{10} to trim 5 percent of radii on each side before taking the mean.}
}
\value{
Data.frame with the lower trunk point cloud (part of the trunk below
diff --git a/man/projected_area_pc.Rd b/man/projected_area_pc.Rd
index c4b3f2e..03c4d35 100644
--- a/man/projected_area_pc.Rd
+++ b/man/projected_area_pc.Rd
@@ -43,16 +43,16 @@ hull fitted to the provided point clouds.
\dontrun{
# Read tree point cloud and calculate the projected tree area
pc_tree <- read_tree_pc(PC_path = "path/to/point_cloud.txt")
-pta <- projected_crown_area_pc(pc = pc_tree)
+pa <- projected_area_pc(pc = pc_tree)
# and plot the concave hull fitting
-output <- projected_crown_area_pc(pc = pc_tree, plot = TRUE)
-pca <- output$pca
+output <- projected_area_pc(pc = pc_tree, plot = TRUE)
+pa <- output$pa
# classify the tree point cloud and calculate the projected crown area
crown_pc <- classify_crown_pc(
pc, thresholdbranch, minheight, buttress,
thresholdR2, thresholdbuttress,
maxbuttressheight, FALSE
)
-pca <- projected_crown_area_pc(pc = crown_pc$crownpoints)
+pca <- projected_area_pc(pc = crown_pc$crownpoints)
}
}
diff --git a/man/summary_basic_pointcloud_metrics.Rd b/man/summary_basic_pointcloud_metrics.Rd
index da53f6f..1235be8 100644
--- a/man/summary_basic_pointcloud_metrics.Rd
+++ b/man/summary_basic_pointcloud_metrics.Rd
@@ -23,6 +23,12 @@ summary_basic_pointcloud_metrics(
maxbuttressheight = 7,
functional = TRUE,
concavity_fdiameter = 4,
+ how = "median",
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
OUT_path = FALSE,
overwrite = FALSE,
plot = FALSE,
@@ -96,6 +102,36 @@ computation of the functional diameter using a concave hull based on
functions \code{\link{diameter_slice_pc}}, \code{\link{dbh_pc}},
\code{\link{dab_pc}}, and \code{\link{classify_crown_pc}}.}
+\item{how}{Method used to summarise point-to-centre radii when estimating
+DBH with \code{\link{dbh_pc}}. Use \code{"mean"} for the original ITSMe
+behaviour, \code{"median"} for the median radius, or a numeric value such
+as \code{10} to trim 5 percent of radii on each side before taking the
+mean. Only relevant when buttress == FALSE.}
+
+\item{arc_min_length_cm}{Optional numeric. Minimum arc length, in centimetres,
+represented by one angular sector when calculating arc coverage with
+\code{\link{dbh_pc}}. If supplied, this is converted to degrees based on
+the fitted radius. Only relevant when buttress == FALSE.}
+
+\item{arc_min_angle}{Numeric. Minimum angular sector width in degrees used
+to calculate arc coverage with \code{\link{dbh_pc}}. Default is 18,
+corresponding to 20 sectors. Only relevant when buttress == FALSE.}
+
+\item{arc_tolerance}{Numeric. Radial tolerance, in metres, around the fitted
+DBH circle. Points within radius +/- arc_tolerance are counted as
+supporting the fitted circle when calculating arc coverage with
+\code{\link{dbh_pc}}. Only relevant when buttress == FALSE.}
+
+\item{min_inner_buffer}{Numeric. Minimum buffer distance, in metres, excluded
+from the fitted DBH radius before checking whether the inner circle is
+empty with \code{\link{dbh_pc}}. Only relevant when buttress == FALSE.}
+
+\item{inner_buffer_fraction}{Numeric. Fraction of the fitted DBH radius used
+as buffer before checking whether the inner circle is empty with
+\code{\link{dbh_pc}}. The effective buffer is
+\code{max(min_inner_buffer, inner_buffer_fraction * radius)}. Only relevant
+when buttress == FALSE.}
+
\item{OUT_path}{A character with name of the output file (including the path
to the folder), where the summary csv file should be saved or logical
(default=FALSE) in this case no csv file is produced.}
diff --git a/man/summary_basic_pointcloud_metrics_pertree.Rd b/man/summary_basic_pointcloud_metrics_pertree.Rd
index c204933..a16194e 100644
--- a/man/summary_basic_pointcloud_metrics_pertree.Rd
+++ b/man/summary_basic_pointcloud_metrics_pertree.Rd
@@ -23,6 +23,12 @@ summary_basic_pointcloud_metrics_pertree(
maxbuttressheight = 7,
functional = TRUE,
concavity_fdiameter = 4,
+ how = "median",
+ arc_min_length_cm = NULL,
+ arc_min_angle = 18,
+ arc_tolerance = 0.05,
+ min_inner_buffer = 0.06,
+ inner_buffer_fraction = 0.5,
OUT_path = FALSE,
overwrite = FALSE,
plot = FALSE,
@@ -91,6 +97,36 @@ computation of the functional diameter using a concave hull based on
functions \code{\link{diameter_slice_pc}}, \code{\link{dbh_pc}},
\code{\link{dab_pc}}, and \code{\link{classify_crown_pc}}.}
+\item{how}{Method used to summarise point-to-centre radii when estimating
+DBH with \code{\link{dbh_pc}}. Use \code{"mean"} for the original ITSMe
+behaviour, \code{"median"} for the median radius, or a numeric value such
+as \code{10} to trim 5 percent of radii on each side before taking the
+mean. Only relevant when buttress == FALSE.}
+
+\item{arc_min_length_cm}{Optional numeric. Minimum arc length, in centimetres,
+represented by one angular sector when calculating arc coverage with
+\code{\link{dbh_pc}}. If supplied, this is converted to degrees based on
+the fitted radius. Only relevant when buttress == FALSE.}
+
+\item{arc_min_angle}{Numeric. Minimum angular sector width in degrees used
+to calculate arc coverage with \code{\link{dbh_pc}}. Default is 18,
+corresponding to 20 sectors. Only relevant when buttress == FALSE.}
+
+\item{arc_tolerance}{Numeric. Radial tolerance, in metres, around the fitted
+DBH circle. Points within radius +/- arc_tolerance are counted as
+supporting the fitted circle when calculating arc coverage with
+\code{\link{dbh_pc}}. Only relevant when buttress == FALSE.}
+
+\item{min_inner_buffer}{Numeric. Minimum buffer distance, in metres, excluded
+from the fitted DBH radius before checking whether the inner circle is
+empty with \code{\link{dbh_pc}}. Only relevant when buttress == FALSE.}
+
+\item{inner_buffer_fraction}{Numeric. Fraction of the fitted DBH radius used
+as buffer before checking whether the inner circle is empty with
+\code{\link{dbh_pc}}. The effective buffer is
+\code{max(min_inner_buffer, inner_buffer_fraction * radius)}. Only relevant
+when buttress == FALSE.}
+
\item{OUT_path}{A character with name of the output folder where the summary
figures should be saved or logical (default=FALSE) in this case no figures
are saved.}
@@ -142,4 +178,6 @@ summary <- summary_basic_pointcloud_metrics(
crown = TRUE, minheight = 4, buttress = TRUE
)
}
+
+
}
diff --git a/tests/output/circle_tree_1_pc_1.3_0.06_.jpeg b/tests/output/circle_tree_1_pc_1.3_0.06_.jpeg
index ec96b4b..15be97f 100644
Binary files a/tests/output/circle_tree_1_pc_1.3_0.06_.jpeg and b/tests/output/circle_tree_1_pc_1.3_0.06_.jpeg differ
diff --git a/tests/output/circle_tree_2_pc_1.3_0.06_.jpeg b/tests/output/circle_tree_2_pc_1.3_0.06_.jpeg
index 7a01a37..9fbe4fb 100644
Binary files a/tests/output/circle_tree_2_pc_1.3_0.06_.jpeg and b/tests/output/circle_tree_2_pc_1.3_0.06_.jpeg differ
diff --git a/tests/output/crown_tree_1_pc_1.5_1.jpeg b/tests/output/crown_tree_1_pc_1.5_1.jpeg
index 6c5b49f..5f254b5 100644
Binary files a/tests/output/crown_tree_1_pc_1.5_1.jpeg and b/tests/output/crown_tree_1_pc_1.5_1.jpeg differ
diff --git a/tests/output/crown_tree_2_pc_1.5_1.jpeg b/tests/output/crown_tree_2_pc_1.5_1.jpeg
index 8e5c9e2..fcf87b3 100644
Binary files a/tests/output/crown_tree_2_pc_1.5_1.jpeg and b/tests/output/crown_tree_2_pc_1.5_1.jpeg differ
diff --git a/tests/output/cv_tree_1_pc_1.png b/tests/output/cv_tree_1_pc_1.png
index f22443a..e229eef 100644
Binary files a/tests/output/cv_tree_1_pc_1.png and b/tests/output/cv_tree_1_pc_1.png differ
diff --git a/tests/output/cv_tree_2_pc_1.png b/tests/output/cv_tree_2_pc_1.png
index 04f4458..65d6579 100644
Binary files a/tests/output/cv_tree_2_pc_1.png and b/tests/output/cv_tree_2_pc_1.png differ
diff --git a/tests/output/dab_buttressed_tree_1_pc_0.001_7.jpeg b/tests/output/dab_buttressed_tree_1_pc_0.001_7.jpeg
index 3f22bc3..2c032cd 100644
Binary files a/tests/output/dab_buttressed_tree_1_pc_0.001_7.jpeg and b/tests/output/dab_buttressed_tree_1_pc_0.001_7.jpeg differ
diff --git a/tests/output/dab_buttressed_tree_2_pc_0.001_7.jpeg b/tests/output/dab_buttressed_tree_2_pc_0.001_7.jpeg
index 7ded592..512ac38 100644
Binary files a/tests/output/dab_buttressed_tree_2_pc_0.001_7.jpeg and b/tests/output/dab_buttressed_tree_2_pc_0.001_7.jpeg differ
diff --git a/tests/output/dbh_tree_1_pc_0.001_0.06.jpeg b/tests/output/dbh_tree_1_pc_0.001_0.06.jpeg
index 17e68b7..806d191 100644
Binary files a/tests/output/dbh_tree_1_pc_0.001_0.06.jpeg and b/tests/output/dbh_tree_1_pc_0.001_0.06.jpeg differ
diff --git a/tests/output/dbh_tree_2_pc_0.001_0.06.jpeg b/tests/output/dbh_tree_2_pc_0.001_0.06.jpeg
index 14c10af..754676c 100644
Binary files a/tests/output/dbh_tree_2_pc_0.001_0.06.jpeg and b/tests/output/dbh_tree_2_pc_0.001_0.06.jpeg differ
diff --git a/tests/output/pa_tree_1_pc_2.jpeg b/tests/output/pa_tree_1_pc_2.jpeg
index 83b18cf..987cba1 100644
Binary files a/tests/output/pa_tree_1_pc_2.jpeg and b/tests/output/pa_tree_1_pc_2.jpeg differ
diff --git a/tests/output/pa_tree_2_pc_2.jpeg b/tests/output/pa_tree_2_pc_2.jpeg
index 49f19a0..134fe04 100644
Binary files a/tests/output/pa_tree_2_pc_2.jpeg and b/tests/output/pa_tree_2_pc_2.jpeg differ
diff --git a/tests/output/pca_tree_1_pc_2.jpeg b/tests/output/pca_tree_1_pc_2.jpeg
index cf851a4..4943062 100644
Binary files a/tests/output/pca_tree_1_pc_2.jpeg and b/tests/output/pca_tree_1_pc_2.jpeg differ
diff --git a/tests/output/pca_tree_2_pc_2.jpeg b/tests/output/pca_tree_2_pc_2.jpeg
index b7f94ca..cd153b1 100644
Binary files a/tests/output/pca_tree_2_pc_2.jpeg and b/tests/output/pca_tree_2_pc_2.jpeg differ
diff --git a/tests/output/summary.csv b/tests/output/summary.csv
index 9d60863..c68a631 100644
--- a/tests/output/summary.csv
+++ b/tests/output/summary.csv
@@ -1,7 +1,7 @@
"tree_id","X_position","Y_position","dbh_m","tree_height_m","tree_vol_L","trunk_vol_L","branch_len","trunk_h","sba_degrees","sbcs","sbr","sbl","sbd","dhr","dvr_m.2","vb55","clvr_m.2","sr","bar","rvr","csh","ch","ce","cdhr","dmr"
-"buttressed_tree_1",85.2236099243164,75.7809677124023,0.301454269644934,24.5395,1026.66333007812,959.432983398438,25.9014892578125,4.15521669387817,22.9888162612915,1.2,0.00155442804924976,0.0505576516518766,0.323744244045681,0.0122844503614554,0.293625242874891,0,385.264497690882,0,0.307405832425525,0.253307041325149,0.848889100711671,0.169447915685344,0.897809396233974,0.790502631960077,0.398244062631868
-"buttressed_tree_1",85.2246780395508,75.7769470214844,0.301454269644934,24.5395,1018.20880126953,948.72412109375,29.1572856903076,4.36369895935059,50.4814929962158,1.2,0.00129364225343823,0.050097455575969,0.256524324417114,0.0122844503614554,0.29606331164008,0,419.621787371633,0,1.07081795779017,0.262634237600462,0.816726886657007,0.168944364494807,0.901381033333469,0.90182319733417,0.404589567804186
-"buttressed_tree_1",85.2260589599609,75.7789459228516,0.301454269644934,24.5395,951.65283203125,865.199584960938,27.6657524108887,4.19629383087158,32.3067359924316,1.2,0.00153597452594716,0.0652658248089056,0.321276982625326,0.0122844503614554,0.316769161503462,0,320.008194781285,0,0.421744723893959,0.32313431176697,0.84744775622434,0.163730118977902,0.907749009726945,0.800689195664612,0.406058044814702
-"buttressed_tree_2",22.0143775939941,121.897308349609,0.406113982557915,21.92075,1972.27331542969,1823.498046875,31.9329261779785,18.5851249694824,38.5950078964233,1,0.00246639556343013,0.140558910194763,0.5,0.0185264638553843,0.205911614470856,0,214.638848843831,0,1.62493616864086,0.353781629351534,0.837684492042881,0.0985592562802108,0,2.68628666215479,1.08987221079005
-"buttressed_tree_2",22.0047149658203,121.903816223145,0.406113982557915,21.92075,1944.77197265625,1807.63427734375,25.8372001647949,18.6727695465088,110.630966186523,1,0.003372439288373,0.130249100572843,0.5,0.0185264638553843,0.208823444736931,0,188.403279503139,0,2.04760563620932,0.448199065510322,0.812181885841778,0.127003948712641,0,1.71001481423224,1.08230564650183
-"buttressed_tree_2",22.0058917999268,121.919059753418,0.406113982557915,21.92075,1920.74133300781,1809.96337890625,30.1243362426758,18.5511341094971,12.2875642776489,1,0.00243811551048342,0.170063135263189,0.5,0.0185264638553843,0.211436061472137,0,271.934322927471,0,0.224864937787742,0.350686770071542,0.812610350264991,0.12251658614071,0,2.19448042989013,1.08628994417607
+"buttressed_tree_1",85.2236099243164,75.7809677124023,0.3057888528798,24.5395,1026.66333007812,959.432983398438,25.9014892578125,4.15521669387817,22.9888162612915,1.2,0.00155442804924976,0.0505576516518766,0.323744244045681,0.0124610873440698,0.29784725325344,0,385.264497690882,0,0.307405832425525,0.253307041325149,0.848889100711671,0.169447915685344,0.897809396233974,0.790502631960077,0.403970377403598
+"buttressed_tree_1",85.2246780395508,75.7769470214844,0.3057888528798,24.5395,1018.20880126953,948.72412109375,29.1572856903076,4.36369895935059,50.4814929962158,1.2,0.00129364225343823,0.050097455575969,0.256524324417114,0.0124610873440698,0.300320378785308,0,419.621787371633,0,1.07081795779017,0.262634237600462,0.816726886657007,0.168944364494807,0.901381033333469,0.90182319733417,0.410407124011538
+"buttressed_tree_1",85.2260589599609,75.7789459228516,0.3057888528798,24.5395,951.65283203125,865.199584960938,27.6657524108887,4.19629383087158,32.3067359924316,1.2,0.00153597452594716,0.0652658248089056,0.321276982625326,0.0124610873440698,0.321323956160684,0,320.008194781285,0,0.421744723893959,0.32313431176697,0.84744775622434,0.163730118977902,0.907749009726945,0.800689195664612,0.411896716118012
+"buttressed_tree_2",22.0143775939941,121.897308349609,0.406064051267357,21.92075,1972.27331542969,1823.498046875,31.9329261779785,18.5851249694824,38.5950078964233,1,0.00246639556343013,0.140558910194763,0.5,0.0185241860459773,0.205886297852633,0,214.638848843831,0,1.62493616864086,0.353781629351534,0.837684492042881,0.0985592562802108,0,2.68628666215479,1.08973821213853
+"buttressed_tree_2",22.0047149658203,121.903816223145,0.406064051267357,21.92075,1944.77197265625,1807.63427734375,25.8372001647949,18.6727695465088,110.630966186523,1,0.003372439288373,0.130249100572843,0.5,0.0185241860459773,0.208797770112214,0,188.403279503139,0,2.04760563620932,0.448199065510322,0.812181885841778,0.127003948712641,0,1.71001481423224,1.08217257815149
+"buttressed_tree_2",22.0058917999268,121.919059753418,0.406064051267357,21.92075,1920.74133300781,1809.96337890625,30.1243362426758,18.5511341094971,12.2875642776489,1,0.00243811551048342,0.170063135263189,0.5,0.0185241860459773,0.211410065628918,0,271.934322927471,0,0.224864937787742,0.350686770071542,0.812610350264991,0.12251658614071,0,2.19448042989013,1.08615638596049
diff --git a/tests/output/summary_basic_metrics.csv b/tests/output/summary_basic_metrics.csv
index ccd2d76..9a57455 100644
--- a/tests/output/summary_basic_metrics.csv
+++ b/tests/output/summary_basic_metrics.csv
@@ -5,3 +5,17 @@
"buttressed_tree_2_pc.txt",22.1299975,121.8939425,21.92075,0.406113982557915,0.000200058845756654,0.417948833197143,5.44,95.0146901606068,41.8840213450001
"buttressed_tree_1_pc.txt",85.3441825,75.82915,24.5395,0.301454269644934,0.000150287512739,0.298260145367115,2.74,53.510789824612,17.7413946750002
"buttressed_tree_2_pc.txt",22.1299975,121.8939425,21.92075,0.406113982557915,0.000200058845756654,0.417948833197143,5.44,95.0146901606068,41.8840213450001
+"buttressed_tree_1_pc.txt",85.3441825,75.82915,24.5395,0.301454269644934,0.000150287512739,0.298260145367115,2.74,NA,NA,NA,53.510789824612,17.7413946750002
+"buttressed_tree_2_pc.txt",22.1299975,121.8939425,21.92075,0.406113982557915,0.000200058845756654,0.417948833197143,5.44,NA,NA,NA,95.0146901606068,41.8840213450001
+"buttressed_tree_1_pc.txt",85.3441825,75.82915,24.5395,0.3057888528798,0.00014210688036038,0.309433581971221,3.16,NA,NA,53.510789824612,17.7413946750002
+"buttressed_tree_2_pc.txt",22.1299975,121.8939425,21.92075,0.406064051267357,0.000200059469040098,0.417948833197143,5.44,NA,NA,95.0146901606068,41.8840213450001
+"buttressed_tree_1_pc.txt",85.3441825,75.82915,24.5395,0.3057888528798,0.00014210688036038,0.309433581971221,3.16,NA,NA,53.510789824612,17.7413946750002
+"buttressed_tree_2_pc.txt",22.1299975,121.8939425,21.92075,0.406064051267357,0.000200059469040098,0.417948833197143,5.44,NA,NA,95.0146901606068,41.8840213450001
+"buttressed_tree_1_pc.txt",85.3441825,75.82915,24.5395,0.3057888528798,0.00014210688036038,0.309433581971221,3.16,NA,NA,53.510789824612,17.7413946750002
+"buttressed_tree_2_pc.txt",22.1299975,121.8939425,21.92075,0.406064051267357,0.000200059469040098,0.417948833197143,5.44,NA,NA,95.0146901606068,41.8840213450001
+"buttressed_tree_1_pc.txt",85.3441825,75.82915,24.5395,0.3057888528798,0.00014210688036038,0.309433581971221,3.16,NA,NA,53.510789824612,17.7413946750002
+"buttressed_tree_2_pc.txt",22.1299975,121.8939425,21.92075,0.406064051267357,0.000200059469040098,0.417948833197143,5.44,NA,NA,95.0146901606068,41.8840213450001
+"buttressed_tree_1_pc.txt",85.3441825,75.82915,24.5395,0.3057888528798,0.00014210688036038,0.309433581971221,3.16,NA,NA,53.510789824612,17.7413946750002
+"buttressed_tree_2_pc.txt",22.1299975,121.8939425,21.92075,0.406064051267357,0.000200059469040098,0.417948833197143,5.44,NA,NA,95.0146901606068,41.8840213450001
+"buttressed_tree_1_pc.txt",85.3441825,75.82915,24.5395,0.3057888528798,0.00014210688036038,0.309433581971221,3.16,NA,NA,53.510789824612,17.7413946750002
+"buttressed_tree_2_pc.txt",22.1299975,121.8939425,21.92075,0.406064051267357,0.000200059469040098,0.417948833197143,5.44,NA,NA,95.0146901606068,41.8840213450001
diff --git a/tests/output/summary_means.csv b/tests/output/summary_means.csv
index 6382f42..f5db61e 100644
--- a/tests/output/summary_means.csv
+++ b/tests/output/summary_means.csv
@@ -1,3 +1,3 @@
"tree_id","X_position","Y_position","dbh_m","tree_height_m","tree_vol_L","trunk_vol_L","branch_len","trunk_h","sba_degrees","sbcs","sbr","sbl","sbd","dhr","dvr_m.2","vb55","clvr_m.2","sr","bar","rvr","csh","ch","ce","cdhr","dmr"
-"buttressed_tree_1",85.2247823079427,75.7789535522461,0.301454269644934,24.5395,998.841654459635,924.452229817708,27.5748424530029,4.23840316136678,35.259015083313,1.2,0.00146134827621172,0.0553069773455837,0.30051518369604,0.0122844503614554,0.302152572006145,0,374.9648266146,0,0.599989504703219,0.279691863564193,0.837687914531006,0.167374133052684,0.902313146431463,0.831005008319619,0.402963891750252
-"buttressed_tree_2",22.0083281199137,121.906728108724,0.406113982557915,21.92075,1945.92887369792,1813.69856770833,29.2981541951497,18.6030095418294,53.8378461201986,1,0.00275898345409552,0.146957048676932,0.5,0.0185264638553843,0.208723706893308,0,224.992150424813,0,1.29913558087931,0.384222488311133,0.820825576049883,0.116026597044521,0,2.19692730209238,1.08615593382265
+"buttressed_tree_1",85.2247823079427,75.7789535522461,0.3057888528798,24.5395,998.841654459635,924.452229817708,27.5748424530029,4.23840316136678,35.259015083313,1.2,0.00146134827621172,0.0553069773455837,0.30051518369604,0.0124610873440698,0.306497196066477,0,374.9648266146,0,0.599989504703219,0.279691863564193,0.837687914531006,0.167374133052684,0.902313146431463,0.831005008319619,0.408758072511049
+"buttressed_tree_2",22.0083281199137,121.906728108724,0.406064051267357,21.92075,1945.92887369792,1813.69856770833,29.2981541951497,18.6030095418294,53.8378461201986,1,0.00275898345409552,0.146957048676932,0.5,0.0185241860459773,0.208698044531255,0,224.992150424813,0,1.29913558087931,0.384222488311133,0.820825576049883,0.116026597044521,0,2.19692730209238,1.0860223920835
diff --git a/tests/output/summary_sds.csv b/tests/output/summary_sds.csv
index d06476e..209e287 100644
--- a/tests/output/summary_sds.csv
+++ b/tests/output/summary_sds.csv
@@ -1,3 +1,3 @@
"tree_id","X_position","Y_position","dbh_m","tree_height_m","tree_vol_L","trunk_vol_L","branch_len","trunk_h","sba_degrees","sbcs","sbr","sbl","sbd","dhr","dvr_m.2","vb55","clvr_m.2","sr","bar","rvr","csh","ch","ce","cdhr","dmr"
-"buttressed_tree_1",0.00122784275060467,0.00201035631672716,0,0,41.0847719474881,51.5928955851205,1.6298009288849,0.110436002011087,13.9820879122398,0,0.000145530463087447,0.00862768376827494,0.0381171696195141,0,0.0127169006139769,0,50.5992033079442,0,0.411737683122091,0.037910208084073,0.0181670824744567,0.00316583636394548,0.00503493845225564,0.0615414774075345,0.00415291420121614
-"buttressed_tree_2",0.00527193864869745,0.0111642375526447,0,0,25.7854633097268,8.56612645689757,3.13071900506761,0.0627589701180986,50.9128103976764,0,0.000531456475927692,0.0206637719598525,0,0,0.00276357366385978,0,42.7171153533276,0,0.954046870263683,0.0554269461641501,0.014601821180411,0.0152926485850353,0,0.488140523465535,0.00378506180439293
+"buttressed_tree_1",0.00122784275060467,0.00201035631672716,0,0,41.0847719474881,51.5928955851205,1.6298009288849,0.110436002011087,13.9820879122398,0,0.000145530463087447,0.00862768376827494,0.0381171696195141,0,0.0128997557590234,0,50.5992033079442,0,0.411737683122091,0.037910208084073,0.0181670824744567,0.00316583636394548,0.00503493845225564,0.0615414774075345,0.00421262857279771
+"buttressed_tree_2",0.00527193864869745,0.0111642375526447,0,0,25.7854633097268,8.56612645689757,3.13071900506761,0.0627589701180986,50.9128103976764,0,0.000531456475927692,0.0206637719598525,0,0,0.00276323388536036,0,42.7171153533276,0,0.954046870263683,0.0554269461641501,0.014601821180411,0.0152926485850353,0,0.488140523465535,0.00378459643499218
diff --git a/tests/output/tree_height_tree_1_pc.jpeg b/tests/output/tree_height_tree_1_pc.jpeg
index fcff3c1..c2d9fb4 100644
Binary files a/tests/output/tree_height_tree_1_pc.jpeg and b/tests/output/tree_height_tree_1_pc.jpeg differ
diff --git a/tests/output/tree_height_tree_2_pc.jpeg b/tests/output/tree_height_tree_2_pc.jpeg
index 5a45449..a5853c9 100644
Binary files a/tests/output/tree_height_tree_2_pc.jpeg and b/tests/output/tree_height_tree_2_pc.jpeg differ
diff --git a/tests/testthat/av_tree_1_pc_1.png b/tests/testthat/av_tree_1_pc_1.png
index 0c2844c..fb3b9f0 100644
Binary files a/tests/testthat/av_tree_1_pc_1.png and b/tests/testthat/av_tree_1_pc_1.png differ
diff --git a/tests/testthat/av_tree_2_pc_1.png b/tests/testthat/av_tree_2_pc_1.png
index e504d2b..c9a5b16 100644
Binary files a/tests/testthat/av_tree_2_pc_1.png and b/tests/testthat/av_tree_2_pc_1.png differ
diff --git a/tests/testthat/test-basic_metrics_pc.R b/tests/testthat/test-basic_metrics_pc.R
index 49295d6..c3e017d 100644
--- a/tests/testthat/test-basic_metrics_pc.R
+++ b/tests/testthat/test-basic_metrics_pc.R
@@ -28,30 +28,83 @@ test_that("tree height calculation works", {
})
test_that("diameter slice calculation works", {
- # output is a list of 5
- expect_equal(length(
- diameter_slice_pc(pc = read_tree_pc(
- path = "../point_clouds/pc_tree.txt"))), 5) &
- # with plot TRUE, output is a list of 6
- expect_equal(length(
- diameter_slice_pc(pc = read_tree_pc(path = "../point_clouds/pc_tree.txt"),
- plot = TRUE)), 6) &
- # with no points at slice height, NaN is returned
- expect_equal((diameter_slice_pc(
+ out <- diameter_slice_pc(pc = read_tree_pc(
+ path = "../point_clouds/pc_tree.txt"
+ ))
+
+ expect_true(all(c(
+ "diameter",
+ "R2",
+ "center",
+ "fdiameter",
+ "hull",
+ "arc_coverage",
+ "inner_circle_empty",
+ "all_points_in_donut"
+ ) %in% names(out)))
+
+ out_plot <- diameter_slice_pc(
+ pc = read_tree_pc(path = "../point_clouds/pc_tree.txt"),
+ plot = TRUE
+ )
+
+ expect_true(all(c(
+ "diameter",
+ "R2",
+ "center",
+ "fdiameter",
+ "hull",
+ "arc_coverage",
+ "inner_circle_empty",
+ "all_points_in_donut",
+ "plot"
+ ) %in% names(out_plot)))
+
+ # with no points at slice height, NaN is returned
+ expect_equal(
+ diameter_slice_pc(
pc = read_tree_pc(path = "../point_clouds/pc_tree.txt"),
- slice_height = 25))[[1]], NaN) &
- # with diameter over 3 m, NaN is returned
- expect_equal((diameter_slice_pc(
- pc = read_tree_pc(path = "../point_clouds/pc_tree_buttress.txt"),
- slice_height = 0.5))[[1]], NaN) &
- # with plot TRUE, output is a list of 6
- expect_equal(length(diameter_slice_pc(
+ slice_height = 25
+ )$diameter,
+ NaN
+ )
+
+ # with diameter over 3 m, NaN is returned
+ expect_equal(
+ diameter_slice_pc(
pc = read_tree_pc(path = "../point_clouds/pc_tree_buttress.txt"),
- slice_height = 0.5, plot = TRUE)), 6) &
- # with less than 3 point within the slice, NaN is returned
- expect_equal((diameter_slice_pc(
+ slice_height = 0.5
+ )$diameter,
+ NaN
+ )
+
+ out_buttress_plot <- diameter_slice_pc(
+ pc = read_tree_pc(path = "../point_clouds/pc_tree_buttress.txt"),
+ slice_height = 0.5,
+ plot = TRUE
+ )
+
+ expect_true(all(c(
+ "diameter",
+ "R2",
+ "center",
+ "fdiameter",
+ "hull",
+ "arc_coverage",
+ "inner_circle_empty",
+ "all_points_in_donut",
+ "plot"
+ ) %in% names(out_buttress_plot)))
+
+ # with less than 3 points within the slice, NaN is returned
+ expect_equal(
+ diameter_slice_pc(
pc = read_tree_pc(path = "../point_clouds/pc_tree.txt"),
- slice_height = 1.3, slice_thickness = 0.005))[[1]], NaN)
+ slice_height = 1.3,
+ slice_thickness = 0.005
+ )$diameter,
+ NaN
+ )
})
test_that("extract lower trunk method works", {
@@ -62,17 +115,42 @@ test_that("extract lower trunk method works", {
})
test_that("dbh calculation from a tree point cloud works", {
- # output is a list of 4
- expect_equal(length(
- dbh_pc(pc = read_tree_pc(path = "../point_clouds/pc_tree.txt"))), 4) &
- # with branches at bh, output is a list of 3
- expect_equal(length(
- dbh_pc(pc = read_tree_pc(path = "../point_clouds/pc_tree_temp.ply"))),
- 4) &
- # with plot TRUE, output is a list of 5
- expect_equal(length(
- dbh_pc(pc = read_tree_pc(path = "../point_clouds/pc_tree.txt"),
- plot = TRUE)), 5)
+ out <- dbh_pc(pc = read_tree_pc(path = "../point_clouds/pc_tree.txt"))
+
+ expect_true(all(c(
+ "dbh",
+ "R2",
+ "center",
+ "fdbh",
+ "arc_coverage",
+ "inner_circle_empty"
+ ) %in% names(out)))
+
+ out_branches <- dbh_pc(pc = read_tree_pc(path = "../point_clouds/pc_tree_temp.ply"))
+
+ expect_true(all(c(
+ "dbh",
+ "R2",
+ "center",
+ "fdbh",
+ "arc_coverage",
+ "inner_circle_empty"
+ ) %in% names(out_branches)))
+
+ out_plot <- dbh_pc(
+ pc = read_tree_pc(path = "../point_clouds/pc_tree.txt"),
+ plot = TRUE
+ )
+
+ expect_true(all(c(
+ "dbh",
+ "R2",
+ "center",
+ "fdbh",
+ "arc_coverage",
+ "inner_circle_empty",
+ "plot"
+ ) %in% names(out_plot)))
})
test_that("dab calculation from a tree point cloud works", {
diff --git a/tests/testthat/test-summary_metrics.R b/tests/testthat/test-summary_metrics.R
index 803988c..bb34422 100644
--- a/tests/testthat/test-summary_metrics.R
+++ b/tests/testthat/test-summary_metrics.R
@@ -1,19 +1,46 @@
test_that("summary basic point cloud metrics works", {
- # output is a data frame with length 10
- expect_equal(length(
- summary_basic_pointcloud_metrics(PCs_path = "../non_buttressed_trees/", pattern = ".txt", overwrite = TRUE)
- ), 10) &
- # with buttress TRUE & OUT_path specified, output is a data frame with length 10
- expect_equal(length(
- summary_basic_pointcloud_metrics(
- PCs_path = "../buttressed_trees/",
- buttress = TRUE,
- minheight = 4,
- OUT_path = "../output/",
- pattern = ".txt",
- overwrite = TRUE
- )
- ), 10)
+ out <- summary_basic_pointcloud_metrics(
+ PCs_path = "../non_buttressed_trees/",
+ pattern = ".txt",
+ overwrite = TRUE
+ )
+
+ expect_s3_class(out, "data.frame")
+
+ expect_true(all(c(
+ "stem_diameter_m",
+ "R2",
+ "functional_stem_diameter_m",
+ "height_stem_diameter_m"
+ ) %in% names(out)))
+
+ expect_true(all(c(
+ "dbh_arc_coverage",
+ "dbh_inner_circle_empty"
+ ) %in% names(out)))
+
+ out_buttress <- summary_basic_pointcloud_metrics(
+ PCs_path = "../buttressed_trees/",
+ buttress = TRUE,
+ minheight = 4,
+ OUT_path = "../output/",
+ pattern = ".txt",
+ overwrite = TRUE
+ )
+
+ expect_s3_class(out_buttress, "data.frame")
+
+ expect_true(all(c(
+ "stem_diameter_m",
+ "R2",
+ "functional_stem_diameter_m",
+ "height_stem_diameter_m"
+ ) %in% names(out_buttress)))
+
+ expect_true(all(c(
+ "dbh_arc_coverage",
+ "dbh_inner_circle_empty"
+ ) %in% names(out_buttress)))
})
test_that("summary qsm metrics works", {
diff --git a/vignettes/ITSMe.Rmd b/vignettes/ITSMe.Rmd
index 51cc166..75cff15 100644
--- a/vignettes/ITSMe.Rmd
+++ b/vignettes/ITSMe.Rmd
@@ -266,6 +266,67 @@ The `dbh_pc` and `dab_pc` functions also output a center value which gives the X
and Y coordinate of the center of the estimated circle fit. This can also be
used as a tree position value.
+### Other DBH estimation options and quality control
+
+
+The `how` argument in `dbh_pc()` controls how point-to-centre distances are summarised into
+the final fitted radius. "mean" follows the original ITSMe logic, while "median" (new default) or adding a number makes the fit less sensitive to outlier points:
+
+```{r dbh-how-example, eval=FALSE}
+# Original ITSMe behaviour
+out_mean <- dbh_pc(pc = pc_tree, how = "mean")
+
+# Median radius, more robust to a few distant slice points (new default)
+out_median <- dbh_pc(pc = pc_tree, how = "median")
+
+# Trim 20 percent of radii in total:
+# 10 percent lowest and 10 percent highest
+out_trimmed <- dbh_pc(pc = pc_tree, how = 20)
+```
+
+In addition to the original outputs (`dbh`, `R2`, `center`, and `fdbh`),
+`dbh_pc()` returns quality-control metrics that can help identify unreliable
+DBH fits:
+
+- `arc_coverage`: proportion of angular sectors around the fitted DBH circle
+ that contain nearby slice points;
+- `inner_circle_empty`: whether the checked inner part of the fitted circle
+ contains no slice points;
+
+
+```{r dbh-qc-example, eval=FALSE}
+out <- dbh_pc(pc = pc_tree, how = "median", plot = TRUE)
+
+out$dbh
+out$R2
+out$arc_coverage
+out$inner_circle_empty
+```
+
+Low `arc_coverage`, high `R2`, or `inner_circle_empty = FALSE` can be used to
+flag DBH estimates for inspection.
+
+When `"stem diameter"` is included in `summary_basic_pointcloud_metrics()`, the
+DBH quality-control metrics are also included in the returned summary table:
+
+```{r summary-dbh-qc-example, eval=FALSE}
+summary <- summary_basic_pointcloud_metrics(
+ PCs_path = "path/to/folder/",
+ pattern = "\\.ply$",
+ metrics = c("tree position", "stem diameter", "tree height"),
+ how = "median"
+)
+
+summary$dbh_arc_coverage
+summary$dbh_inner_circle_empty
+summary$dbh_all_points_in_donut
+```
+
+For buttressed trees, `summary_basic_pointcloud_metrics()` may calculate
+diameter above buttresses instead of DBH. In that case, the DBH-specific
+quality-control columns are returned as `NA`.
+
+
#### Classify crown points
As a basis for crown metrics (e.g. projected crown area and 3D alpha crown