plot_crowns(): support SI units

Author: ctoney

R/plot_crowns.R

@@ -24,9 +24,9 @@
 #' @param linear_unit An optional character string specifying the linear
 #' distance unit. Defaults to the native FIA unit of `"ft"`, but may be set to
 #' `"m"` instead (or `"meter"` / `"metre"`), in which case subplot boundaries
-#' will be display in meters, tree heights and crown widths are assumed to be
-#' given in meters, and tree diameters are assumed to be given in centimeters.
-#' **TODO: not currently implemented**
+#' will be displayed in meters, tree distances and crown widths are assumed to
+#' be given in meters, and tree diameters are assumed to be given in
+#' centimeters.
 #' @param main Character string giving the main plot title (on top).
 #' @param crown_col The color of tree crowns, e.g., either a color name (as
 #' listed by `colors()`) or a hexadecimal string.
@@ -49,11 +49,21 @@
 #'
 #' plot_crowns(plantation, subplot = 4, microplot = TRUE,
 #'             main = "plantation microplot 4")
+#'
+#' # using SI units
+#' metric_trees <- within(plantation, {
+#'   CRWIDTH <- calc_crwidth(plantation) |> ft_to_m()
+#'   rm(DIST, DIA)
+#'   DIST <- ft_to_m(plantation$DIST)
+#'   DIA <- in_to_cm(plantation$DIA)
+#' })
+#' plot_crowns(metric_trees, linear_unit = "meter",
+#'             main = "plantation plot (SI units)")
 #' @export
 plot_crowns <- function(tree_list, subplot = NULL, microplot = FALSE,
                         linear_unit = "ft", main = "", crown_col = "#328e13",
                         stem_col = "#b85e00", subp_border_lwd = 3,
-                        subp_border_col = "gray61"){
+                        subp_border_col = "gray61") {
 
     if (missing(tree_list) || is.null(tree_list))
         stop("'tree_list' is required", call. = FALSE)
@@ -87,8 +97,17 @@ plot_crowns <- function(tree_list, subplot = NULL, microplot = FALSE,
     else
         linear_unit <- tolower(linear_unit)
 
-    if (!(linear_unit %in% c("ft", "foot", "m", "meter", "metre")))
+    si_units <- FALSE  # US customary units by default
+    axis_unit_name <- "feet"
+    if (!(linear_unit %in% c("ft", "foot", "m", "meter", "metre"))) {
         stop("'linear_unit' is invalid", call. = FALSE)
+    } else if (linear_unit %in% c("m", "meter", "metre")) {
+        si_units <- TRUE
+        if (linear_unit == "metre")
+            axis_unit_name <- "metres"
+        else
+            axis_unit_name <- "meters"
+    }
 
     if (is.null(subplot) || is.na(subplot))
         subplot <- FALSE
@@ -105,20 +124,34 @@ plot_crowns <- function(tree_list, subplot = NULL, microplot = FALSE,
     if (!(is.logical(microplot) && length(microplot) == 1))
         stop("'microplot' must be a single logical value", call. = FALSE)
 
+    tree_min_dia <- 5  # min diamater for tree vs sapling
+    subp_radius <- 24
+    micr_radius <- 6.8
+    if (si_units) {
+        tree_min_dia <- in_to_cm(5)
+        subp_radius <- ft_to_m(24)
+        micr_radius <- ft_to_m(6.8)
+    }
+
     if (subplot && microplot) {
         trees_in <- tree_list[tree_list$STATUSCD == 1 &
                               tree_list$SUBP == subplot &
-                              tree_list$DIA < 5, ]
+                              tree_list$DIA < tree_min_dia, ]
     } else if (subplot && !microplot) {
         trees_in <- tree_list[tree_list$STATUSCD == 1 &
                               tree_list$SUBP == subplot &
-                              tree_list$DIA >= 5, ]
+                              tree_list$DIA >= tree_min_dia, ]
     } else {
-        trees_in <- tree_list[tree_list$STATUSCD == 1 & tree_list$DIA >= 5, ]
+        trees_in <- tree_list[tree_list$STATUSCD == 1 &
+                              tree_list$DIA >= tree_min_dia, ]
     }
 
     trees_in$height <- pmin(trees_in$HT, trees_in$ACTUALHT, na.rm = TRUE)
-    trees_in$dia_ft <- 0.0833333 * trees_in$DIA
+    if (si_units) {
+        trees_in$dia_ft_or_m <- trees_in$DIA / 100
+    } else {
+        trees_in$dia_ft_or_m <- 0.0833333 * trees_in$DIA
+    }
     trees_in <- trees_in[order(trees_in$height), ]
 
     if (subplot) {
@@ -127,7 +160,7 @@ plot_crowns <- function(tree_list, subplot = NULL, microplot = FALSE,
         pts$x <- trees_in$DIST * sin(trees_in$AZIMUTH * (pi / 180))
         pts$y <- trees_in$DIST * cos(trees_in$AZIMUTH * (pi / 180))
     } else {
-        pts <- .get_tree_list_xy(trees_in)
+        pts <- .get_tree_list_xy(trees_in, linear_unit = linear_unit)
     }
 
     crowns <- lapply(seq_len(nrow(trees_in)), \(i) {
@@ -136,13 +169,13 @@ plot_crowns <- function(tree_list, subplot = NULL, microplot = FALSE,
 
     if (subplot) {
         if (microplot) {
-            fia_poly <- gdalraster::g_buffer("POINT (0 0)", 6.8)
+            fia_poly <- gdalraster::g_buffer("POINT (0 0)", micr_radius)
         } else {
-            fia_poly <- gdalraster::g_buffer("POINT (0 0)", 24)
+            fia_poly <- gdalraster::g_buffer("POINT (0 0)", subp_radius)
         }
         stems <- lapply(seq_len(nrow(trees_in)), \(i) {
             gdalraster::g_create("POINT", c(pts$x[i], pts$y[i])) |>
-                gdalraster::g_buffer(trees_in$dia_ft[i] / 2)})
+                gdalraster::g_buffer(trees_in$dia_ft_or_m[i] / 2)})
     } else {
         fia_poly <- .get_fia_plot_geom(linear_unit = linear_unit)
     }
@@ -151,8 +184,8 @@ plot_crowns <- function(tree_list, subplot = NULL, microplot = FALSE,
                    gdalraster::g_envelope())
     names(rct) <- c("xmin", "xmax", "ymin", "ymax")
 
-    xlab <- sprintf("x (%s)", linear_unit)
-    ylab <- sprintf("y (%s)", linear_unit)
+    xlab <- sprintf("x (%s)", axis_unit_name)
+    ylab <- sprintf("y (%s)", axis_unit_name)
     gdalraster::plot_geom(fia_poly, xlab, ylab, main, border = subp_border_col,
                           lwd = subp_border_lwd, bbox = rct)