R/sw_Miscellaneous_Functions.R

In DrylandEcology/rSOILWAT2: An Ecohydrological Ecosystem-Scale Water Balance Simulation Model

#' Calculate climate variables from daily weather
#'
#' @param weatherList A list. Each element is an object of class
#'   \code{\link[rSOILWAT2:swWeatherData-class]{rSOILWAT2::swWeatherData}}
#'   containing daily weather data of a specific year.
#' @param year.start An integer value. The first year of the range of years for
#'   which climate variables should be calculated.
#' @param year.end An integer value. The last year of the range of years for
#'   which climate variables should be calculated.
#' @param do_C4vars A logical value. If \code{TRUE} then additional output is
#'   returned.
#' @param do_Cheatgrass_ClimVars A logical value. If \code{TRUE} then additional
#'   output is returned.
#' @param simTime2 A list with two named elements. The elements are numeric
#'   vectors \var{month_ForEachUsedDay_NSadj} and
#'   \var{year_ForEachUsedDay_NSadj}; they are calculated internally
#'   if \code{NULL}; alternatively, they can be generated by a call to the
#'   function \code{\link[rSW2data]{simTiming_ForEachUsedTimeUnit}}.
#'   They are only used if \code{isTRUE(do_C4vars)}.
#' @param latitude A numeric value. The latitude in degree of the site. Used
#'   to adjust seasons between northern/southern hemisphere only if
#'   \code{isTRUE(do_C4vars)} and \code{simTime2} has to be re-calculated.
#'
#' @return A list with named elements \itemize{
#'   \item{\var{\dQuote{meanMonthlyTempC}}} {A numeric vector of length 12.
#'    Mean monthly mean daily air temperature in degree Celsius.}
#'   \item{\var{\dQuote{minMonthlyTempC}}} {A numeric vector of length 12.
#'     Mean monthly minimum daily air temperature in degree Celsius.}
#'   \item{\var{\dQuote{maxMonthlyTempC}}} {A numeric vector of length 12.
#'     Mean monthly maximum daily air temperature in degree Celsius.}
#'   \item{\var{\dQuote{meanMonthlyPPTcm}}} {A numeric vector of length 12.
#'     Mean monthly precipitation in centimeters.}
#'   \item{\var{\dQuote{MAP_cm}}} {A numeric value. Mean annual precipitation
#'     in centimeters.}
#'   \item{\var{\dQuote{MAT_C}}} {A numeric value. Mean annual air temperature
#'     in degree Celsius.}
#'   \item{\var{\dQuote{dailyTempMin}}} {A numeric vector. If
#'     \code{isTRUE(do_C4vars)}, then minimum daily air temperature in degree
#'     Celsius for each day of time period between \code{year.start} and
#'     \code{year.end}. If \code{!isTRUE(do_C4vars)}, then \code{NA}.}
#'   \item{\var{\dQuote{dailyTempMean}}} {A numeric vector. Similar as for
#'     \code{dailyTempMin} but for mean daily air temperature.}
#'   \item{\var{\dQuote{dailyC4vars}}} {If \code{isTRUE(do_C4vars)}, then a
#'     named numeric vector containing the output of
#'     \code{\link{sw_dailyC4_TempVar}}, else \code{NA}.}
#'   \item{\var{\dQuote{monthlyCheatgrass_ClimVars}}} {
#'     If \code{isTRUE(do_Cheatgrass_ClimVars)}, then a named numeric vector
#'     containing the output of \code{\link{sw_Cheatgrass_ClimVar}},
#'     else \code{NA}.}
#' }
#'
#' @examples
#' ## Load weather dataset from rSOILWAT2
#' utils::data("weatherData", package = "rSOILWAT2")
#' clim1 <- calc_SiteClimate(weatherList = weatherData)
#' clim2 <- calc_SiteClimate(weatherList = weatherData, do_C4vars = TRUE)
#' clim3 <- calc_SiteClimate(weatherList = weatherData,
#'   do_Cheatgrass_ClimVars = TRUE)
#'
#' @export
calc_SiteClimate <- function(weatherList, year.start = NA, year.end = NA,
  do_C4vars = FALSE, do_Cheatgrass_ClimVars = FALSE, simTime2 = NULL,
  latitude = 90) {

      x <- dbW_weatherData_to_dataframe(weatherList)

      # Trim to requested years
      if (!is.na(year.start)) {
          x <- x[x[, "Year"] >= year.start, ]
      } else {
          year.start <- x[1, "Year"]
      }

      if (!is.na(year.end)) {
          x <- x[x[, "Year"] <= year.end, ]
      } else {
          year.end <- x[nrow(x), "Year"]
      }

      years <- unique(x[, "Year"])

      if (length(years) == 0) {
        stop("'calc_SiteClimate': no weather data available for ",
          "requested range of years")
      }

      res <- .Call(C_rSW2_calc_SiteClimate,
                   weatherList,
                   year.start,
                   year.end,
                   do_C4vars,
                   do_Cheatgrass_ClimVars,
                   latitude
      )

      res[["dailyTempMin"]] <- if (do_C4vars) x[, "Tmin_C"] else NA
      res[["dailyTempMean"]] <- if (do_C4vars) {
        rowMeans(x[, c("Tmax_C", "Tmin_C"), drop = FALSE])
      } else {
        NA
      }
      res[["dailyC4vars"]] <- if (do_C4vars) res[["dailyC4vars"]] else NA
      res[["Cheatgrass_ClimVars"]] <- if (do_Cheatgrass_ClimVars)
                                            res[["Cheatgrass_ClimVars"]] else NA

      res
}


#' \var{Look-up} yearly atmospheric CO2 concentration values
#'
#' @param start An integer value. First year for which to \var{look-up} values.
#' @param end An integer value. Last year for which to \var{look-up} values.
#' @param name_co2 A character string. The (partial) name of the CO2 series,
#'   i.e., a column name of \code{tr_CO2a}. See details.
#' @param tr_CO2a A numeric \code{data.frame} with the CO2 values [ppm].
#'   Default values are taken from \code{\link{sw2_tr_CO2a}}.
#'
#' @section Details: \code{name_co2} may contain multiple data set names,
#'   either as vector of strings, or as names separated by "|".
#'   Values of the first match are used;
#'   any missing values are filled in from the second matching column,
#'   and so forth.
#'
#' @seealso \code{\link{sw2_tr_CO2a}} for description of data
#'
#' @examples
#' lookup_annual_CO2a(start = 1765, end = 2300, name_co2 = "RCP45")
#' lookup_annual_CO2a(start = 1765, end = 2300, name_co2 = "CMIP5_RCP45")
#' lookup_annual_CO2a(start = 1980, end = 2005, name_co2 = "CMIP5_historical")
#' lookup_annual_CO2a(
#'   start = 1980,
#'   end = 2021,
#'   name_co2 = c("CMIP6_historical", "CMIP6_SSP119")
#' )
#' lookup_annual_CO2a(
#'   start = 1980,
#'   end = 2021,
#'   name_co2 = "CMIP6_historical|CMIP6_SSP119"
#' )
#'
#' \dontrun{
#' ## This fails because "CMIP5_historical" has no values after 2005
#' lookup_annual_CO2a(start = 1980, end = 2020, name_co2 = "CMIP5_historical")
#' }
#'
#' @export
lookup_annual_CO2a <- function(
  start,
  end,
  name_co2,
  tr_CO2a = rSOILWAT2::sw2_tr_CO2a
) {
  # Locate scenario
  name_co2 <- paste0(name_co2, collapse = "|")
  scenario_index <- grep(name_co2, colnames(tr_CO2a), ignore.case = TRUE)
  n_sc <- length(scenario_index)

  # Locate years
  ids_years <- match(start:end, tr_CO2a[, "Year"], nomatch = NA)


  if (n_sc > 0 && length(ids_years) > 0 && !anyNA(ids_years)) {
    # Extract values
    x <- tr_CO2a[ids_years, scenario_index]

    if (n_sc > 1) {
      # Take values from first match; if NA, then from second match, etc.
      tmp <- rep(NA, length(ids_years))
      for (k in seq_len(n_sc)) {
        if (!anyNA(tmp)) break
        ids <- is.na(tmp)
        tmp[ids] <- x[ids, k]
      }
      x <- tmp
    }

    scenarioCO2_ppm <- cbind(
      Year = tr_CO2a[ids_years, "Year"],
      CO2ppm = as.numeric(x)
    )

    # Check for missing values
    if (anyNA(scenarioCO2_ppm)) {
      stop(
        "Some requested years have no CO2 values for scenario(s) ",
        shQuote(name_co2)
      )
    }

  } else {
    stop("Lookup of CO2 failed.")
  }

  scenarioCO2_ppm
}