R/dm_join_subdaily_clim.R

In dendRoAnalyst: A Tool for Processing and Analyzing Dendrometer Data

#' @title Join subdaily climate features to point-level dendrometer output
#'
#' @description
#' Joins timestamp-level subdaily climate features to point-level output from
#' \code{phase.zg()} or \code{phase.sc()}.
#'
#' The climate input can be:
#' \itemize{
#'   \item the output of \code{dm_subdaily_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 subdaily climate-feature table,
#' the function attempts to standardize it with \code{read.climate()} and then
#' joins by exact timestamp using the \code{TIME} column.
#'
#' @param x Object returned by \code{phase.zg()} or \code{phase.sc()}.
#' @param clim_sub Climate input. This can be a subdaily climate-feature table,
#'   a standardized climate object returned by \code{read.climate()}, a raw
#'   climate data frame, or a valid climate file path.
#'
#' @return
#' The same phase object with climate features appended to \code{ZG_phase} or
#' \code{SC_phase}. The returned object has class
#' \code{c("ZG_output_clim", "ZG_output", ...)} or
#' \code{c("SC_output_clim", "SC_output", ...)}.
#'
#' @examples
#' \donttest{
#' data(gf_nepa17)
#' data(ktm_clim_hourly)
#'
#' zg <- phase.zg(df = gf_nepa17[1:800, ], TreeNum = 1)
#'
#' clim_sub <- dm_subdaily_clim(
#'   ktm_clim_hourly,
#'   mean_vars = c("temp", "VPD", "RH"),
#'   sum_vars  = c("prec"),
#'   lag_vars  = c("temp", "VPD", "RH"),
#'   roll_hours = c(1, 3, 6, 24),
#'   lag_hours  = c(1, 3, 6, 24)
#' )
#'
#' zg_point_clim <- dm_join_subdaily_clim(zg, clim_sub)
#' head(zg_point_clim$ZG_phase)
#' }
#'
#' @importFrom dplyr left_join
#' @importFrom tibble as_tibble
#' @export
dm_join_subdaily_clim <- function(x, clim_sub) {

  if (!inherits(x, "ZG_output") && !inherits(x, "SC_output")) {
    stop("'x' must be an object returned by phase.zg() or phase.sc().")
  }

  # standardize climate input
  clim <- if (inherits(clim_sub, "subdaily_clim") || inherits(clim_sub, "dm_clim")) {
    tibble::as_tibble(clim_sub)
  } else if (is.data.frame(clim_sub) || (is.character(clim_sub) && length(clim_sub) == 1 && file.exists(clim_sub))) {
    tibble::as_tibble(read.climate(clim_sub, verbose = FALSE))
  } else {
    stop(
      "'clim_sub' must be one of: output of dm_subdaily_clim(), output of read.climate(), ",
      "a raw climate data frame, or a valid climate file path."
    )
  }

  if (!"TIME" %in% names(clim)) {
    stop("Climate input must contain a 'TIME' column after standardization.")
  }

  clim$TIME <- as.POSIXct(clim$TIME)

  phase_name <- if (inherits(x, "ZG_output")) "ZG_phase" else "SC_phase"
  ph <- tibble::as_tibble(x[[phase_name]])

  if (!"TIME" %in% names(ph)) {
    names(ph)[1] <- "TIME"
  }

  ph$TIME <- as.POSIXct(ph$TIME)

  out <- x
  out[[phase_name]] <- dplyr::left_join(ph, clim, by = "TIME")

  if (inherits(x, "ZG_output")) {
    class(out) <- unique(c("ZG_output_clim", class(x)))
  } else {
    class(out) <- unique(c("SC_output_clim", class(x)))
  }

  out
}