#' 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)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.