R/CalcDominantMortCause.R

In bmcnellis/RSFIA: FIA Tree Mortality Analysis

#' @title Calculates dominant mort cause
#' @description
#'
#' To avoid having 'multiple' category, set multiple_cutoff to 0
#'
#' @param tree_data Tree data input, defaults to package data
#' @param db_ver FIA database version to base AGENTCD key off of
#' @param multiple_cutoff Cutoff for assigning a plot to the 'Multiple' category
#' @export
CalcDominantMortCause <- function(tree_data = NULL, db_ver = 7.2,
                                  multiple_cutoff = 75) {

  # Inputs/declarations
  if (length(tree_data) < 1) {
    tree_df <- FIA_mortality_TREE_level
  } else {
    tree_df <- tree_data
  }
  out_df <- data.frame(unique(tree_df$PLT_CN))
  colnames(out_df)[1] <- 'PLT_CN'
  out_df$dominant_AGENTCD <- NA
  out_df$percent_AGENTCD <- 0
  out_df$n_tree <- NA
  out_df$n_dead <- NA
  c1 <- 0
  c0 <- nrow(out_df)

  # Work loop
  message('Running CalcDominantMortCause...')
  for (i in out_df$PLT_CN) {
    c1 <- c1 + 1
    cat('\r', format(c1 / c0 * 100, digits = 2, nsmall = 2), '%')
    i_df <- tree_df[which(tree_df$PLT_CN == i), ]
    i_tbl <- table(i_df$AGENTCD)
    i_vec <- i_df$AGENTCD
    if (all(is.na(i_vec))) {
      val1 <- 0
      val2 <- 0
      val3 <- 0
    } else {
      i0 <- names(i_tbl[which.max(i_tbl)])
      val2 <- i_tbl[which.max(i_tbl)] / sum(i_tbl)
      val2 <- as.numeric(round(val2 * 100, 2))
      if (val2 < multiple_cutoff) {
        val1 <- 'Multiple'
      } else {
        val1 <- i0
      }
      val3 <- length(na.omit(i_vec))
    }

    out_df[which(out_df$PLT_CN == i), 2] <- val1
    out_df[which(out_df$PLT_CN == i), 3] <- val2
    out_df[which(out_df$PLT_CN == i), 4] <- length(i_vec)
    out_df[which(out_df$PLT_CN == i), 5] <- val3
  }

  # Formatting
  kFUN <- KeyAgentCode(db_ver = db_ver)
  dx <- which(out_df$dominant_AGENTCD != 'Multiple')
  out_df$dominant_AGENTCD[dx] <- kFUN(as.numeric(out_df$dominant_AGENTCD[dx]))
  out_df$percent_AGENTCD <- ifelse(
    out_df$percent_AGENTCD < 0.01,
    NA,
    out_df$percent_AGENTCD
  )

  # Return
  return(out_df)
}