R/DiamClass.R

In ryanmismith/inventoryfunctions: Forestry Inventory Functions

#' Diameter Class Assignment
#'
#'
#' This function assigns each tree a diameter class
#'
#'@param Tree The Tree ID for each Tree.
#'@param DBH The unique Plot ID for each Plot.
#'@param Convert Change units from metric to English
#'@param Binwidth Size of bins for diameter classes
#'
#'@return Returns diameter class for each tree
#'
#'@details
#' This function will return a diameter class value for each tree.
#' If the data is in metric for other parts of the analysis,
#' but will be finallyu reported in english, set Convert to TRUE,
#' otherwise it will return values in the unit supplied. Binwidth
#' determines the binwidth for the diameter classes. The default value is one
#' but the bin width can be changed to whatever is desired.
#'
#' Class sizes will use (bin1 + bin2)/2 as the break between bins.
#' for example if binwidth is 2, all values greater than (3 + 5)/2 will be 5, etc.
#'
#' This function is primarily for visualizing diameter distributions. Useful
#' for examining stand structure and exploring appropriate silvicultural treatments.
#' Maximum bin = 100.
#'
#' The first bin will always have a value of 1.
#'@examples
#'
#' Tree <- seq(1,15,1)
#' DBH <- c(10,13,5,16,7,10,1,44,4,7,30,70,18,15,18)
#' data <- data.frame(Tree, DBH)
#'
#' mapply(DiamClass,data$Tree, data$DBH)
#' mapply(DiamClass,data$Tree, data$DBH, TRUE)
#' mapply(DiamClass,data$Tree, data$DBH, Binwidth = 2)
#' mapply(DiamClass,data$Tree, data$DBH, TRUE, 3)
#' mapply(DiamClass,data$Tree, data$DBH, Binwidth = 5)
#' mapply(DiamClass,data$Tree, data$DBH, Convert = TRUE, Binwidth = 2)
#'@export

DiamClass <- function(Tree, DBH, Convert = FALSE, Binwidth = 1){

   data <- data.frame(Tree, DBH)

   data$DBH <- ifelse(Convert == TRUE, data$DBH/2.54, data$DBH)

   bins <- seq(0, 1000, Binwidth)


     for(i in 1:length(DBH)) {
     data$class[i] <- sapply(data$DBH[i], function(DBH,Bins) {bins[which.min(abs(data$DBH[i]-Bins))]}, bins)
     }

   class <- data$class

   class <- ifelse(class == 0, 1, class)

   return(class)


}