R/PlotPolarBar.R

In bmcnellis/RSFIA: FIA Tree Mortality Analysis

#' @title Plots a polar bar chart of mortality causes
#' @description TODO this
#'
#' @param type Either plots or trees
#' @param clear_plots Logical to clear plot environment
#' @param drop_no_mort Logical to drop 'No Mortality' case
#' @param split Logical to split by outlier/background
#' @param priv Logical to split by public/private, requires split = T
#' @param only_common_ftypes Logical to exclude less common (<30 plots) ftypes
#' @param split_scale Scale the split plots to be proportions of themselves?
#' @param return_df Return the dataframe instead of plotting
#'
#' @export
#' @examples PlotPolarBar()
PlotPolarBar <- function(
  type = c('plots', 'trees'),
  clear_plots = F, drop_no_mort = F,
  split = F, priv = F, only_common_ftypes = F,
  split_scale = F, return_df = F) {

  # Setup:
  if (length(type) == 2) {
    type <- 'plots'
    message('Setting type to plots')
  }
  if (type == 'trees') {
    mort_df <- PrepPlotEnvir(clear = clear_plots)
    pkg_df <- FIA_mortality_TREE_level
    if (drop_no_mort) {
      pkg_df <- pkg_df[-which(is.na(pkg_df$AGENTCD)), ]
    }
    if (only_common_ftypes) {
      warning('Ignoring only_common_ftypes for type == trees')
    }
    pkg_df[, 'Section'] <- rep(NA, nrow(pkg_df))
    pkg_df[, 'mort_outlier'] <- rep(NA, nrow(pkg_df))
    pkg_df[, 'is_public'] <- rep(NA, nrow(pkg_df))
    mort_df[which(mort_df$PLT_CN %in% pkg_df$PLT_CN), 'Cleland_section']
    cat('\n')
    message('Adding variables to tree dataframe...')
    for (i in 1:nrow(mort_df)) {
      cat('\r', format(i / nrow(mort_df) * 100, digits = 2, nsmall = 2))
      indx <- which(pkg_df$PLT_CN %in% mort_df[i, 'PLT_CN'])
      pkg_df[indx, 'Section'] <- mort_df[i, 'Cleland_section']
      pkg_df[indx, 'mort_outlier'] <- mort_df[i, 'mort_outlier']
      pkg_df[indx, 'is_public'] <- mort_df[i, 'is_public']
    }
    cat('\n')
    pkg_df$Section <- as.factor(KeyClelandCode(pkg_df$Section, lvl = 'section'))
    FUN_df <- pkg_df[, c('Section', 'AGENTCD')]
  } else if (type == 'plots') {
    pkg_df <- PrepPlotEnvir(clear = clear_plots)
    if (drop_no_mort) {
      pkg_df <- pkg_df[-which(pkg_df$dominant_AGENTCD == 'No Mortality'), ]
    }
    if (only_common_ftypes) {
      pkg_df <- pkg_df[pkg_df$is_common_ftype, ]
    }
    FUN_df <- pkg_df[, c('Cleland_section', 'dominant_AGENTCD', 'percent_AGENTCD')]
    FUN_df[, 4] <- as.factor(KeyClelandCode(FUN_df$Cleland_section, lvl = 'section'))
    colnames(FUN_df)[4] <- c('Section')
  } else {
    stop('bad type input')
  }

  full_df <- FUN_df
  high_df <- FUN_df[pkg_df$mort_outlier, ]
  back_df <- FUN_df[!pkg_df$mort_outlier, ]
  pub_df <- FUN_df[pkg_df$is_public, ]
  priv_df <- FUN_df[!pkg_df$is_public, ]

  # Generating the polar coordinate dataframe:
  scale <- ifelse(split_scale, logical(), nrow(FUN_df))
  cc0 <- c('%_Total')
  cnt <- 0
  j0_df <- data.frame(stringsAsFactors = F)
  for (i in cc0) {
    cnt <- cnt + 1
    for (j in c(1:5)) {
      j_df <- switch(j, full_df, high_df, back_df, pub_df, priv_df)
      FUN0 <- switch(cnt, length)
      if (type == 'plots') {
        j0_df <- AggregateDominantAgent(
          j_df, i, join_df = j0_df, FUN0 = FUN0, join = as.logical(j - 1),
          scale = scale
        )
      } else if (type == 'trees') {
        jj_df <- aggregate(j_df$Section, by = list(j_df$AGENTCD), FUN = FUN0)
        jj_df[, 2] <- round(jj_df[, 2] / sum(jj_df[, 2]), 3)
        jj_df[, 1] <- KeyAgentCode(7.2)(jj_df[, 1])
        jj_df[, 3] <- as.character(jj_df[, 2])
        colnames(jj_df) <- c('Dominant_AGENTCD', '%_Total', 'perc_as_char')
        if (j == 1) {
          j0_df <- jj_df
        } else {
          j0_df <- dplyr::left_join(j0_df, jj_df, by = 'Dominant_AGENTCD')
        }
      }
    }
  }
  cc0 <- c(cc0, 'perc_as_char')
  cc1 <- c('_Full', '_High', '_Back', '_Pub', '_Priv')
  cnames_full <- sapply(cc1, function(x) paste0(cc0, x))
  colnames(j0_df) <- c('Dominant_AGENTCD', cnames_full)

  if (return_df) {
    return(j0_df)
  }

  # Plot function:
  PolarPlot <- function(polar_df, yylab, llab) {
    p_lab <- polar_df$perc_as_char[order(polar_df$Dominant_AGENTCD)]
    polar_bar <- ggplot(data = polar_df) + theme_bw() +
      geom_bar(aes(x = Dominant_AGENTCD,
                   y = `%_Total`,
                   fill = Dominant_AGENTCD),
               stat = 'identity') +
      guides(fill = guide_legend(title = llab)) +
      scale_fill_brewer(palette = "Paired") +
      scale_x_discrete(labels = p_lab) +
      #xlab('') + ylab('Fraction of total plots') +
      xlab('') + ylab(yylab) +
      coord_polar()
    return(polar_bar)
  }

  # Returns:
  l0 <- ifelse(type == 'plots', 'Dominant\nPlot', 'Tree')
  y0 <- ifelse(type == 'plots', 'plots', 'trees')
  # y lab for all plots:
  y00 <- paste0('Fraction of total ', y0)
  if (split) {
    if (priv) {
      lab1 <- paste0(l0, '\nPublic Land\nMortality\nAgent')
      lab2 <- paste0(l0, '\nPrivate Land\nMortality\nAgent')
      p1df <- j0_df[, c('Dominant_AGENTCD', '%_Total_Pub', 'perc_as_char_Pub')]
      p2df <- j0_df[, c('Dominant_AGENTCD', '%_Total_Priv', 'perc_as_char_Priv')]
    } else {
      lab1 <- paste0(l0, '\nBackground\nMortality\nAgent')
      lab2 <- paste0(l0, '\nOutlier\nMortality\nAgent')
      p1df <- j0_df[, c('Dominant_AGENTCD', '%_Total_Back', 'perc_as_char_Back')]
      p2df <- j0_df[, c('Dominant_AGENTCD', '%_Total_High', 'perc_as_char_High')]
    }
    colnames(p1df)[2:3] <- c('%_Total', 'perc_as_char')
    p1 <- PolarPlot(polar_df = p1df, llab = lab1, yylab = y00)
    colnames(p2df)[2:3] <- c('%_Total', 'perc_as_char')
    p2 <- PolarPlot(polar_df = p2df, llab = lab2, yylab = y00)
    Multiplot(p1, p2)
  } else {
    if (priv) warning('Ignoring priv argument')
    lab0 <- paste0(l0, '\nMortality\nAgent')
    polar_full <- j0_df[, c('Dominant_AGENTCD', '%_Total_Full', 'perc_as_char_Full')]
    colnames(polar_full)[2:3] <- c('%_Total', 'perc_as_char')
    p0 <- PolarPlot(polar_df = polar_full, llab = lab0, yylab = y00)
    print(p0)
  }

  invisible()
}