R/dm_join_daily_clim.R

In dendRoAnalyst: A Tool for Processing and Analyzing Dendrometer Data

#' @title Join daily climate summaries to daily dendrometer statistics
#'
#' @description
#' Joins daily climate summaries to the output of \code{daily.data()} by
#' calendar date.
#'
#' The climate input can be:
#' \itemize{
#'   \item the output of \code{dm_daily_clim()}
#'   \item the output of \code{read.climate()}
#'   \item a raw climate data frame
#'   \item a valid climate file path readable by \code{read.climate()}
#' }
#'
#' If the supplied climate input is not already a daily climate table, it will
#' first be converted to daily summaries with \code{dm_daily_clim()} using
#' default daily means for numeric variables.
#'
#' @param daily_obj Output of \code{daily.data()} with class \code{"daily_output"}.
#' @param clim_daily Climate input. This can be a daily climate table, a
#'   standardized climate object returned by \code{read.climate()}, a raw
#'   climate data frame, or a valid climate file path.
#'
#' @return
#' The \code{daily.data()} output with climate columns appended. The returned
#' object has class \code{c("daily_output_clim", "daily_output", ...)}.
#'
#' @examples
#' \donttest{
#' data(nepa17)
#' data(ktm_clim_hourly)
#'
#' dd <- daily.data(df = nepa17[1:1000, ], TreeNum = 1)
#'
#' clim_std <- read.climate(
#'   ktm_clim_hourly,
#'   time_col = "TIME",
#'   vars = c("temp", "prec", "VPD", "RH"),
#'   verbose = FALSE
#' )
#'
#' clim_day <- dm_daily_clim(
#'   clim_std,
#'   mean_vars = c("temp", "VPD", "RH"),
#'   max_vars  = c("temp", "VPD"),
#'   sum_vars  = c("prec")
#' )
#'
#' dd_clim <- dm_join_daily_clim(dd, clim_day)
#' head(dd_clim)
#' }
#'
#' @importFrom dplyr left_join
#' @importFrom tibble as_tibble
#' @export
dm_join_daily_clim <- function(daily_obj, clim_daily) {

  if (!inherits(daily_obj, "daily_output")) {
    stop("'daily_obj' must be an object returned by daily.data().")
  }

  # prepare climate input
  clim <- NULL

  if (inherits(clim_daily, "daily_clim")) {
    clim <- tibble::as_tibble(clim_daily)

  } else if (inherits(clim_daily, "dm_clim") ||
             is.data.frame(clim_daily) ||
             (is.character(clim_daily) && length(clim_daily) == 1 && file.exists(clim_daily))) {

    # standardize raw climate first if needed
    if (!inherits(clim_daily, "dm_clim")) {
      clim_daily <- read.climate(clim_daily, verbose = FALSE)
    }

    # if there is no DATE column, create daily summaries
    clim <- dm_daily_clim(clim_daily)

  } else {
    stop(
      "'clim_daily' must be one of: ",
      "output of dm_daily_clim(), output of read.climate(), ",
      "a raw climate data frame, or a valid climate file path."
    )
  }

  if (!"DATE" %in% names(clim)) {
    if ("TIME" %in% names(clim)) {
      clim$DATE <- as.Date(clim$TIME)
    } else {
      stop("Climate input must contain a 'DATE' column or a 'TIME' column.")
    }
  }

  # preserve useful attributes from daily_obj
  old_class <- class(daily_obj)
  old_attrs <- attributes(daily_obj)
  out <- dplyr::left_join(tibble::as_tibble(daily_obj), tibble::as_tibble(clim), by = "DATE")

  # restore selected attributes
  if (!is.null(old_attrs$tree_num)) attr(out, "tree_num") <- old_attrs$tree_num
  if (!is.null(old_attrs$tree_col)) attr(out, "tree_col") <- old_attrs$tree_col

  class(out) <- unique(c("daily_output_clim", old_class))
  out
}