R/ReduceYearlyPrecip.R

In bmcnellis/RSFIA: FIA Tree Mortality Analysis

#' @title ''
#'
#' @description NULL
#'
#' @export
#' @examples ReduceYearlyPrecip(x)
ReduceYearlyPrecip <- function(rain, is_snow = F) {
  if (!(is.numeric(rain))) stop('Input vec must be numeric')

  sum_rain <- sum(rain, na.rm = T)
  mean_rain <- round(mean(rain, na.rm = T), 2)
  rainy_days <- length(which(rain > 0))
  mean_rain_event <- round(mean(rain[which(rain > 0)], na.rm = T), 2)
  sd_rain_event <- round(sd(rain[which(rain > 0)]), 2)
  roll_dry <- zoo::rollapply(
    rain, width = 90, FUN = function(x) sum(x, na.rm = T), fill = NA, align = 'center'
    )
  dry_Q_sum <- min(roll_dry, na.rm = T)
  dry_Q_doy <- round(median(which(roll_dry == dry_Q_sum), na.rm = T))

  # Run-length variables
  rle_df <- rle(rain)
  rle_dry <- rle_df$lengths[which(rle_df$values == 0)]
  if (length(rle_dry) < 1) {
    max_dry_days <- 0
  } else {
    max_dry_days <- max(rle_dry, na.rm = T)
  }
  mean_dry_period <- round(mean(rle_dry, na.rm = T), 2)
  sd_dry_period <- round(sd(rle_dry, na.rm = T), 2)

  out <- data.frame(sum_rain, mean_rain, mean_rain_event, rainy_days, sd_rain_event,
              dry_Q_sum, dry_Q_doy, max_dry_days, mean_dry_period, sd_dry_period,
              stringsAsFactors = F)
  if (is_snow) {
    colnames(out) <- gsub('rain', 'snow', colnames(out))
    colnames(out) <- gsub('dry', 'snowless', colnames(out))
    if (out$sum_snow == 0) out[, ] <- NA
  }
  # Returns a named list
  return(out)
}