sapflux: Analyze Sapflux Traces

#' Scales sapflow measurements
#'
#' @description
#' The two-dimensional flux densities output by \link{GranierConversions}, in order to be
#' scaled to shrub/tree and stand level, must be multiplied by a conducting sapwood
#' area. Conducting sapwood area is often a predictable function of stem diameter, and with
#' this function it becomes possible to scale flux densities with only stem 'dbh' supplied.
#'
#' @param flux            'flux' class object
#' @param sapwood         Sapwood type - used to define sapwood area depth, see details
#' @param merge           Optional logical. Should plants of identical dbh/id be merged?
#' @param ...             Additional parameters to pass to CalculateSapwoodArea
#'
#' @details
#'
#'
#'
#' \code{As.FUN}:
#'
#'      The conversion function between conducting sapwood area and d.b.h. is likely species specific,
#'      but can frequently be computed from literature values. Meinzer et al. (2003) published a
#'      function derived from 107 individuals of 24 co-occuring Panamanian canopy tree species,
#'      all of which were found to have similiar sapwood area-dbh relationships to each other. This
#'      function is used as the default, under strong caution that its likely that this function
#'      does not apply to species that are not broad-leaved wet-mesic tropical angiosperms.
#'
#' \code{units}: Output units, "cm/hr" (the default) and "mm/hr" are currently supported.
#'
#' \code{id}: id vector to group stems by during merging. Passed to \link{FluxMerge}
#'
#' \code{merge}: Should 'FluxMerge' be invoked to merge stems by ID and dbh? Defaults to FALSE.
#' @export
#' @examples
#' myflux <- ScaleFlux(flux = myflux, to = "stem flux")
ScaleFlux <- function(flux, to = "site flux", sapwood_type = "complete") {
  CheckFluxObject(flux)
  # Pull slots ####
  data      <- slot(flux, "data")
  data.tags <- slot(flux, "data.tags")
  metadata  <- slot(flux, "metadata")
  datatype  <- slot(flux, "datatype")
  # Input checks ####
  defaults <- LoadDefaults()
  defaults <- defaults[, 1:2]
  stopifnot(
    to %in% defaults[["datatype"]],
    which(defaults[["datatype"]] == to) >
      which(defaults[["datatype"]] == datatype)
    )
  # Scale 'flux density' to 'stem flux'
  # Flux density to stem flux scaling, requires diameter
  if (datatype == "flux density") {
    # Find relevant areas ####
    sapwood.area <- CalculateSapwoodArea(diameter = metadata$diameter,
                                       sapwood.type = sapwood.type)
    basal.area <- DiameterToArea(metadata$diameter)
    # Scaling to ml/hr ####
    # Multiply each probe's flux by the conducting sapwood area, in cm,
    # converts to cm3 per hour or ml/hr, then to kg/hr
    message("Scaling by sapwood area...")
    for (i in 1:ncol(data)) {
      i.sapwood.area <-
        sapwood.area[which(metadata$port.tag == data.tags[[1]][i])]
      data[, i] <- data[, i] * i.sapwood.area
      # Converts from ml/hr to kg/hr
      data[, i] <- data[, i] / 1000
    }
    # Refresh slot variables ####
    datatype <- "probe flux"
    metadata <- cbind(metadata, basal.area, sapwood.area)
    slot(flux, "metadata") <- metadata
    slot(flux, "data") <- data
    slot(flux, "datatype") <- datatype
    if (to == "datatype") {
      return(flux)
    }
  }
  # Scale 'stem flux' on up  ####
  message(paste("Scaling stem fluxes to", to, "..."))
  while.break <- 0
  while(which(defaults[["datatype"]] == to) >
        which(defaults[["datatype"]] == datatype)) {
    if (slot(flux, "datatype") == "land flux") {
      break
    }
    while.break <- while.break + 1
    # Add a level to the scaling
    to.datatype <-
      defaults[["datatype"]][which(defaults[["datatype"]] == datatype) + 1]
    from.datatype <- slot(flux, "datatype")
    flux <- MergeFluxByMetadata(flux, from = from.datatype,
                               to = to.datatype, weights = "basal.area")
    datatype <- slot(flux, "datatype")
    if (while.break > 10) {
      stop("Error in datatype scaling - tried too many types")
    }
  }
  if (slot(flux, "datatype") == "land flux") {
    stop("Don't support land flux yet!")
  }
  # Clean up and return ####
  log.message <- paste("NULL\n")
  log <- c(slot(flux, "log"), log.message)
  return(flux)
}