R/CalculateSapwoodArea.R

In bmcnellis/sapflux: Analyze Sapflux Traces

#' @title Calculates woody plant conducting sapwood area
#'
#' @description
#'
#' Sapwood area is an important component of tree water fluxes as well as
#' biometric scaling and can be calculated from DBH or other plant
#' diameter measurements.
#'
#' @param diameter       Vector of diameters (cm) to use in conversion
#' @param sapwood.FUN    Function to convert between diameters and sapwood
#' @param sapwood.depth  Vector of sapwood depths
#' @param sapwood.type   Length-one character describing sapwood life history
#'
#' @details
#' Diameter is required for scaling, as is one of the three parameters
#' describing the sapwood measurement (sapwood.*). Supplying more than one
#' will throw an error.
#'
#' Types currently supported are "tropical" and "complete:
#'
#' \code{tropical} : area is 1.582 * (diam) ^ 1.764, a function obtained
#'                   by Meinzer et al. (2001) on 34 Panaminian tree
#'                   species across the isthmus wet-dry gradient.
#'
#' \code{complete} : all sapwood is conducting - sapwood area is just the
#'                   stem basal area
#'
#' @return Returns a numeric vector of sapwood area
#'
#' @family utils
#' @export
#' @examples
#' # Using a custom function:
#' diams <- c(2, 4, 6, 4)
#' sapwoodFunction <- function(diameter) {
#'   sapwood <- diameter * 0.75
#'   return(sapwood)
#' } # Scales sapwood by 0.75 of diameter
#' areas <- CalculateSapwoodArea(diams, sapwood.FUN)
#' print(areas) # Returns 1.5, 3.0, 4.5, 3.0
#' # Just using depths:
#' diams <- c(2, 4, 6, 4)
#' depths <- c(1, 2, 3, 2)
#' areas <- CalculateSapwoodArea(diams, sapwood.depth = depths)
#' print(areas)
CalculateSapwoodArea <- function(diameter,
                                 sapwood.FUN = NULL,
                                 sapwood.depth = NULL,
                                 sapwood.type = NULL) {
  # Diameter to area function: ####
  DiameterToArea <- function(diameter) {
    area <- pi * ((diameter / 2) ^ 2)
    return(area)
  }
  # Input checks ####
  inputs <- list(sapwood.FUN, sapwood.depth, sapwood.type)
  stopifnot(
    is.numeric(diameter),
    sum(unlist(lapply(X = inputs, FUN = length))) == 1,
    all(!(is.na(diameter)))
  )
  if (!(all(diameter < 200)) |
      !(all(diameter > 0.5))) {
    stop("Diameters must be in centimeters")
  }
  basal.area <- DiameterToArea(diameter)
  # Calculate sapwood area ####
  sapwood.area <- vector(mode = "numeric", length = length(diameter))
  if (length(sapwood.FUN) > 0) {
    stopifnot(class(sapwood.FUN) == "function")
    sapwood.area <- sapwood.FUN(diameter)
  } else  if (length(sapwood.depth) > 0) {
    stopifnot(
      all(sapwood.depth < diameter),
      length(sapwood.depth) == length(diameter),
      is.numeric(sapwood.depth),
      all(!is.na(sapwood.depth))
      )
    dead.diam <- diameter - sapwood.depth
    dead.area <- DiameterToArea(dead.diam)
    sapwood.area <- basal.area - dead.area
  } else if (length("sapwood.type") > 0) {
    stopifnot(
      is.character(sapwood.type),
      length(sapwood.type) == 1
    )
    if (sapwood.type == "tropical") {
      As.FUN <- function(diameter) {
        # Reference: Meinzer et al. (2001)
        # Diameter here must be in centimeters
        As <- 1.582 * (diameter ^ 1.764)
        return(As)
      }
      sapwood.area <- As.FUN(diameter)
    } else if (sapwood.type == "complete") {
      sapwood.area <- basal.area
    } else {
      stop("Unsupported sapwood type")
    }
  }
  stopifnot(
    length(sapwood.area) == length(diameter),
    class(sapwood.area) == "numeric"
  )
  return(sapwood.area)
}