add convenience functions for unit conversion

Author: ctoney

NAMESPACE

@@ -7,8 +7,12 @@ export(calc_crown_overlay)
 export(calc_crwidth)
 export(calc_ht_metrics)
 export(calc_tcc_metrics)
+export(cm_to_in)
 export(create_fia_owin)
 export(create_fia_ppp)
+export(ft_to_m)
+export(in_to_cm)
 export(load_tree_data)
+export(m_to_ft)
 export(plot_crowns)
 export(process_tree_data)

R/convert_units.R

@@ -0,0 +1,72 @@
+#' Convenience functions for unit conversion
+#'
+#' Functions to convert between SI and US customary units.
+#'
+#' @name convert_units
+#' @details
+#' `ft_to_m(x)` converts feet to meters.
+#'
+#' `m_to_ft(x)` converts meters to feet.
+#'
+#' `in_to_cm(x)` converts inches to centimeters.
+#'
+#' `cm_to_in(x)` converts centimeters to inches.
+#'
+#' @param x Numeric vector of values to convert.
+#' @return
+#' A numeric vector of the converted values.
+#'
+#' @examples
+#' ft_to_m(1)
+#'
+#' m_to_ft(1)
+#'
+#' in_to_cm(1)
+#'
+#' cm_to_in(1)
+#' @export
+ft_to_m <- function(x) {
+    if (!is.numeric(x)) {
+        stop(cli::format_error(c(
+            "{.var x} must be a numeric vector",
+        "x" = "Invalid input type: {.cls {class(x)}}")))
+    }
+
+    x * 0.3048
+}
+
+#' @name convert_units
+#' @export
+m_to_ft <- function(x) {
+    if (!is.numeric(x)) {
+        stop(cli::format_error(c(
+            "{.var x} must be a numeric vector",
+        "x" = "Invalid input type: {.cls {class(x)}}")))
+    }
+
+    x * 3.28084
+}
+
+#' @name convert_units
+#' @export
+in_to_cm <- function(x) {
+    if (!is.numeric(x)) {
+        stop(cli::format_error(c(
+            "{.var x} must be a numeric vector",
+        "x" = "Invalid input type: {.cls {class(x)}}")))
+    }
+
+    x * 2.54
+}
+
+#' @name convert_units
+#' @export
+cm_to_in <- function(x) {
+    if (!is.numeric(x)) {
+        stop(cli::format_error(c(
+            "{.var x} must be a numeric vector",
+        "x" = "Invalid input type: {.cls {class(x)}}")))
+    }
+
+    x * 0.393701
+}

R/spatstat_helpers.R

@@ -106,13 +106,16 @@
 #' plot(K, main = "Ripley's K for the plantation FIA plot")
 #'
 #' ## point pattern object for the `western_redcedar` example data
-#' X <- create_fia_ppp(western_redcedar)
+#' ## tree distances may be specified in meters
+#' trees <- within(western_redcedar, DIST <- ft_to_m(DIST))
+#'
+#' X <- create_fia_ppp(trees, linear_unit = "m")
 #' summary(X)
 #'
 #' plot(X, pch = 16, main = "Western redcedar FIA plot")
 #'
 #' # Ripley's K-function
-#' K <- spatstat.explore::Kest(X, rmax = 12, correction = "isotropic")
+#' K <- spatstat.explore::Kest(X, rmax = ft_to_m(12), correction = "isotropic")
 #' plot(K, main = "Ripley's K for the western redcedar FIA plot")
 #' @export
 create_fia_owin <- function(linear_unit = "ft", macroplot = FALSE,
@@ -241,7 +244,7 @@ create_fia_ppp <- function(tree_list, live_trees = TRUE, min_dia = 5,
         tree_list_in <- tree_list[tree_list$DIA >= min_dia, ]
     }
 
-    xy <- .get_tree_list_xy(tree_list_in)
+    xy <- .get_tree_list_xy(tree_list_in, linear_unit)
 
     marks <- NULL
     if (!is.null(mark_cols))

R/utils.R

@@ -2,17 +2,26 @@
 #'
 #' `.get_tree_list_xy()` returns a named list with two elements each containing
 #' a numeric vector of the x and y coordinates for trees within the FIA
-#' 4-subplot configuration.
+#' 4-subplot configuration. The origin is the center of the center subplot.
 #'
 #' @param tree_list A data frame containing the standard tree list columns for
 #' a plot. This input generally has been pre-filtered, e.g., to live trees with
 #' `DIA >= 5.0`.
+#' @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"`). Specifies units of the input
+#' `tree_list$DIST`.
 #' @return
 #' A named list with elements `x` and `y` containing numeric vectors of stem
 #' coordinates.
 #' @noRd
 #' @export
-.get_tree_list_xy <- function(tree_list) {
+.get_tree_list_xy <- function(tree_list, linear_unit = "ft") {
+    unit_conv <- 1  # FIA native unit ft
+    if (linear_unit %in% c("m", "meter", "metre")) {
+        unit_conv <- 0.3048  # ft to m
+    }
+
     x <- rep(NA_real_, nrow(tree_list))
     y <- rep(NA_real_, nrow(tree_list))
 
@@ -24,23 +33,23 @@
 
     # subplot 2 - offsets from plot center
     xoff2 <- 0.0
-    yoff2 <- 120.0
+    yoff2 <- 120.0 * unit_conv
     dist <- tree_list$DIST[tree_list$SUBP == 2]
     azimuth <- tree_list$AZIMUTH[tree_list$SUBP == 2]
     x[tree_list$SUBP == 2] <- dist * sin(azimuth * (pi / 180)) + xoff2
     y[tree_list$SUBP == 2] <- dist * cos(azimuth * (pi / 180)) + yoff2
 
     # subplot 3 - offsets from plot center
-    xoff3 <- 103.92
-    yoff3 <- -60.0
+    xoff3 <- 103.92 * unit_conv
+    yoff3 <- -60.0 * unit_conv
     dist <- tree_list$DIST[tree_list$SUBP == 3]
     azimuth <- tree_list$AZIMUTH[tree_list$SUBP == 3]
     x[tree_list$SUBP == 3] <- dist * sin(azimuth * (pi / 180)) + xoff3
     y[tree_list$SUBP == 3] <- dist * cos(azimuth * (pi / 180)) + yoff3
 
     # subplot 4 - offsets from plot center
-    xoff4 <- -103.92
-    yoff4 <- -60.0
+    xoff4 <- -103.92 * unit_conv
+    yoff4 <- -60.0 * unit_conv
     dist <- tree_list$DIST[tree_list$SUBP == 4]
     azimuth <- tree_list$AZIMUTH[tree_list$SUBP == 4]
     x[tree_list$SUBP == 4] <- dist * sin(azimuth * (pi / 180)) + xoff4

_pkgdown.yml

@@ -19,6 +19,7 @@ reference:
   - calc_ht_metrics
   - calc_tcc_metrics
   - spatstat_helpers
+  - convert_units
   - load_tree_data
   - plot_crowns
   - process_tree_data

man/convert_units.Rd

@@ -0,0 +1,29 @@
+test_that("convert_units works", {
+    expect_equal(ft_to_m(1), 0.3048)
+    expect_equal(ft_to_m(c(1, 10)), c(0.3048, 3.048))
+
+    expect_equal(m_to_ft(1), 3.28084)
+    expect_equal(m_to_ft(c(1, 2)), c(3.28084, 2 * 3.28084))
+
+    expect_equal(in_to_cm(1), 2.54)
+    expect_equal(in_to_cm(c(1, 10)), c(2.54, 25.4))
+
+    expect_equal(cm_to_in(1), 0.393701)
+    expect_equal(cm_to_in(c(1, 10)), c(0.393701, 3.93701))
+
+    x_ft <- 24
+    x_m <- ft_to_m(x_ft)
+    expect_equal(m_to_ft(x_m), x_ft, tolerance = 1e-4)
+    expect_equal(ft_to_m(x_ft), x_m, tolerance = 1e-4)
+
+    x_in <- 15.1
+    x_cm <- in_to_cm(x_in)
+    expect_equal(cm_to_in(x_cm), x_in, tolerance = 1e-4)
+    expect_equal(in_to_cm(x_in), x_cm, tolerance = 1e-4)
+
+    x <- "char"
+    expect_error(ft_to_m(x), "numeric vector")
+    expect_error(m_to_ft(x), "numeric vector")
+    expect_error(in_to_cm(x), "numeric vector")
+    expect_error(cm_to_in(x), "numeric vector")
+})