R/basalArea.R

In miquelcaceres/IFNdyn: IFN forest dynamics and scenario analysis

#' Basal area
#'
#' Calculates basal area of stands, either total or by species
#'
#' @param x A data frame with tree records in rows and columns 'ID', 'Species', 'DBH' (in cm) and 'N' (ha-1)
#' @param bySpecies A flag to indicate that basal area of the stand should be disaggregated bySpecies
#' @param speciesNames A flag to replace species codes by names in the output
#' @param modelNames A flag to replace species codes by species model names in the output
#'
#' @return If \code{bySpecies = FALSE} returns a vector of basal area per plot 'ID', or a single value if column 'ID' is not included in the input.
#' If \code{bySpecies = TRUE} returns a matrix with plot 'ID' in rows and species in columns, or a numeric vector of basal area per species if 'ID' is not included in the input.
#'
#' @examples
#'
#' data(exampleTreeData)
#'
#' basalArea(exampleTreeData)
#'
#' basalArea(exampleTreeData, bySpecies = TRUE, speciesNames = TRUE)
basalArea<-function(x, bySpecies = FALSE, speciesNames = FALSE, modelNames = FALSE) {
  if(modelNames) speciesNames = FALSE
  SA = x$N*pi*(x$DBH/200)^2
  if(!bySpecies) {
    if("ID" %in% names(x)) {
      res = tapply(SA, as.character(x$ID), FUN=sum, na.rm=T)
      res[is.na(res)] = 0
      return(res)
    }
    return(sum(SA, na.rm=T))
  } else {
    if("ID" %in% names(x)) {
      res = tapply(SA, list(as.character(x$ID), as.character(x$Species)), FUN=sum, na.rm=T)
      if(speciesNames) colnames(res) = speciesNames(colnames(res))
      else if(modelNames) colnames(res) = speciesNamesModels(colnames(res))
      res[is.na(res)] = 0
      return(res)
    }
    res = tapply(SA, as.character(x$Species), FUN=sum, na.rm=T)
    if(speciesNames) names(res) = speciesNames(names(res))
    else if(modelNames) names(res) = speciesNamesModels(names(res))

    return(res)
  }
}