Development for v6.2.0 (#248)

- Updating to SOILWAT2 v8.0.1
- Several fixes to handling of weather data
- The inputs of daily specific humidity changed units (`"%"` to `"g
kg-1"`) and name (`"specHavg_pct"` to `"specHavg_gPERkg"`)

.Rbuildignore

@@ -12,7 +12,7 @@
 ^cran-comments\.md$
 ^NEWS\.md$
 ^tests/
-tests/rSOILWAT_IntegrationTestOutput
+tests/rSOILWAT_IntegrationTestOutput*
 src/SOILWAT2/\.git
 src/SOILWAT2/\.github
 src/SOILWAT2/doc

.github/workflows/check-standard.yml

@@ -21,7 +21,9 @@ on:
   pull_request:
     branches: [main, release/**]
 
-name: R-CMD-check
+name: R-CMD-check.yml
+
+permissions: read-all
 
 jobs:
   R-CMD-check:
@@ -33,7 +35,7 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macOS-latest,   r: 'release'}
+          - {os: macos-latest,   r: 'release'}
           - {os: windows-latest, r: 'release'}
           - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
@@ -45,7 +47,7 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
         with:
           submodules: recursive
 
@@ -72,4 +74,5 @@ jobs:
         with:
           upload-snapshots: true
           error-on: '"error"'
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
 

.gitignore

@@ -34,7 +34,7 @@ Thumbs.db
 # Package check files
 ..Rcheck
 rSOILWAT2.Rcheck
-rSOILWAT_IntegrationTestOutput/
+rSOILWAT_IntegrationTestOutput*
 tests/spelling.Rout.save
 backup/
 

.gitmodules

@@ -1,4 +1,4 @@
 [submodule "src/SOILWAT2"]
 	path = src/SOILWAT2
 	url = https://github.com/DrylandEcology/SOILWAT2
-	branch = master
+	branch = master

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rSOILWAT2
-Version: 6.1.0
+Version: 6.2.0
 Title: An Ecohydrological Ecosystem-Scale Water Balance Simulation Model
-Description: Access to the C-based SOILWAT2 v8.0.0 and functionality for
+Description: Access to the C-based SOILWAT2 v8.0.1 and functionality for
   SQLite-database of weather data.
 Authors@R: c(
   person(

NAMESPACE

@@ -155,6 +155,7 @@ export(swrc_vwc_to_swp)
 export(time_columns)
 export(update_biomass)
 export(update_requested_years)
+export(upgrade_weatherColumns)
 export(upgrade_weatherDF)
 export(upgrade_weatherHistory)
 export(weatherGenerator_dataColumns)

NEWS.md

@@ -1,4 +1,22 @@
-# rSOILWAT2 v6.1.0-9000
+# rSOILWAT2 v6.2.0
+* Simulation output remains the same as the previous version unless
+  relative humidity is calculated from vapor pressure or specific humidity.
+* Update `SOILWAT2` to v8.0.1 which fixed the calculation of relative humidity
+  and the count of days where missing weather was imputed by `"LOCF"`.
+
+## New features
+* `validObject()` method for class `"swInputData"` now includes checks for a
+  valid `"weatherHistory"` object.
+
+## Bugfix
+* `dbW_fixWeather()` now handles data objects with all missing values.
+
+## Changes to interface
+* The inputs of daily specific humidity changed units (`"%"` to `"g kg-1"`)
+  and name (`"specHavg_pct"` to `"specHavg_gPERkg"`).
+
+
+# rSOILWAT2 v6.1.0
 * This version produces the same output as the previous version.
 * `SOILWAT2` updated to v8.0.0 which now includes a simulation domain;
   however, this has no impact on `rSOILWAT2`.

R/A_swGenericMethods.R

@@ -208,6 +208,10 @@ format_timestamp <- function(object) {
 #'
 #' @section Details:
 #' List of changes:
+#'   * Changes with `v6.2.0`:
+#'       * class [`swWeatherData`]: slot `"data"` changed column name
+#'         (`"specHavg_pct"` to `"specHavg_gPERkg"`) and
+#'         units (`"%"` to `"g kg-1"`).
 #'   * Changes with `v6.1.0`:
 #'       * class [`swInputData-class`]:
 #'         new slot `"spinup"` of new class [`swSpinup-class`]
@@ -220,6 +224,14 @@ format_timestamp <- function(object) {
 #'       * class [`swFiles-class`]:
 #'         `SWRC` parameter input file added as file 6 for a new total of 23
 #'       * class [`swProd-class`]: new slot `"veg_method"`
+#'       * class [`swWeatherData`]: new slots `"use_cloudCoverMonthly"`,
+#'         `"use_windSpeedMonthly"`, `"use_humidityMonthly"`,
+#'         `"dailyInputFlags"`, and `"desc_rsds"`
+#'       * class [`swWeatherData`]: slot `"data"` gained 11 new columns:
+#'         `"cloudCov_pct"`, `"windSpeed_mPERs"`, `"windSpeed_east_mPERs"`,
+#'         `"windSpeed_north_mPERs"`, `"rHavg_pct"`, `"rHmax_pct"`,
+#'         `"rHmin_pct"`, `"specHavg_pct"`, `"Tdewpoint_C"`, `"actVP_kPa"`,
+#'         and `"shortWR"`
 #'   * Changes with `v5.4.0`:
 #'       * classes [`swEstabSpecies-class`] and [`swEstab-class`]:
 #'         new slot `"vegType"`

R/D_swWeatherData.R

@@ -32,12 +32,28 @@ weather_dataColumns <- function() {
     "Tmax_C", "Tmin_C", "PPT_cm",
     "cloudCov_pct",
     "windSpeed_mPERs", "windSpeed_east_mPERs", "windSpeed_north_mPERs",
-    "rHavg_pct", "rHmax_pct", "rHmin_pct", "specHavg_pct", "Tdewpoint_C",
+    "rHavg_pct", "rHmax_pct", "rHmin_pct", "specHavg_gPERkg", "Tdewpoint_C",
     "actVP_kPa",
     "shortWR"
   )
 }
 
+#' @return A data frame with four columns:
+#'   * `"old"`: the outdated weather data column name
+#'   * `"new"`: the new weather data column name
+#'   * `"v"`: the `"rSOILWAT2"` version when the name change was introduced
+#'   * `"fail"`: error if non-missing values are present
+#' @md
+#' @noRd
+weather_renamedDataColumns <- function() {
+  rbind(
+    data.frame(
+      old = "specHavg_pct", new = "specHavg_gPERkg", v = "6.2.0", fail = TRUE,
+      stringsAsFactors = FALSE
+    )
+  )
+}
+
 #' Functions to summarize currently implemented daily weather variables
 #' @return A named vector of functions that summarize
 #' daily weather variables across time.
@@ -54,7 +70,8 @@ weather_dataAggFun <- function() {
     rHavg_pct = mean,
     rHmax_pct = mean,
     rHmin_pct = mean,
-    specHavg_pct = mean,
+    specHavg_pct = mean, # specific humidity: rSOILWAT2 v6.0.0 - v6.1.0
+    specHavg_gPERkg = mean, # specific humidity: rSOILWAT2 >= v6.1.1
     Tdewpoint_C = mean,
     actVP_kPa = mean,
     shortWR = mean
@@ -89,7 +106,7 @@ weather_dataAggFun <- function() {
 #'   \var{windSpeed_mPERs},
 #'   \var{windSpeed_east_mPERs}, \var{windSpeed_north_mPERs},
 #'   \var{rHavg_pct}, \var{rHmax_pct}, \var{rHmin_pct},
-#'   \var{specHavg_pct}, \var{Tdewpoint_C},
+#'   \var{specHavg_gPERkg}, \var{Tdewpoint_C},
 #'   \var{actVP_kPa}, and
 #'   \var{shortWR}.
 #'
@@ -156,13 +173,28 @@ setValidity(
     }
 
     tmp <- dim(object@data)
-    if (tmp[2] != ncol(ref@data)) {
+    if (tmp[[2L]] != ncol(ref@data)) {
       msg <- paste(
         "@data must have exactly", ncol(ref@data), "columns corresponding to",
         toString(colnames(ref@data))
       )
       val <- if (isTRUE(val)) msg else c(val, msg)
     }
+
+    cns <- colnames(object@data)
+    validCns <- c("day", colnames(ref@data))
+    if (!all(tolower(cns) %in% tolower(validCns))) {
+      shouldNot <- setdiff(tolower(cns), tolower(validCns))
+      shouldHave <- setdiff(tolower(colnames(ref@data)), tolower(cns))
+      msg <- paste(
+        "@data has column(s)",
+        toString(shQuote(cns[tolower(cns) %in% shouldNot])),
+        "instead of",
+        toString(shQuote(validCns[tolower(validCns) %in% shouldHave]))
+      )
+      val <- if (isTRUE(val)) msg else c(val, msg)
+    }
+
     if (!(tmp[1] %in% c(365, 366))) {
       msg <- "@data must 365 or 366 rows corresponding to day of year."
       val <- if (isTRUE(val)) msg else c(val, msg)
@@ -198,16 +230,62 @@ swWeatherData <- function(...) {
   do.call("new", args = c("swWeatherData", dots[dns %in% sns]))
 }
 
+
 #' @param weatherDF A data frame with weather variables.
 #' @param template_weatherColumns A vector with requested weather variables.
 #'
+#' @return For [upgrade_weatherColumns()]:
+#' an updated `weatherDF` with requested column name changes.
+#'
+#' @examples
+#' upgrade_weatherColumns(
+#'   data.frame(DOY = 1:2, Tmax_C = runif(2), dummy = runif(2))
+#' )
+#' upgrade_weatherColumns(
+#'   data.frame(DOY = 1:2, Tmax_C = runif(2), specHavg_pct = NA)
+#' )
+#'
+#' @md
+#' @rdname sw_upgrade
+#' @export
+upgrade_weatherColumns <- function(
+  weatherDF,
+  template_weatherColumns = c("Year", "DOY", weather_dataColumns())
+) {
+  cns <- colnames(weatherDF)
+  if (!all(cns %in% template_weatherColumns)) {
+    rds <- weather_renamedDataColumns()
+    ids <- match(cns, rds[, "old", drop = TRUE], nomatch = 0L)
+    for (k in which(ids > 0L)) {
+      if (
+        isTRUE(rds[ids[[k]], "fail", drop = TRUE]) &&
+          !all(is_missing_weather(weatherDF[, cns[[k]], drop = TRUE]))
+      ) {
+        stop(
+          "Renaming ", shQuote(cns[[k]]), " to ",
+          shQuote(as.character(rds[ids[[k]], "new", drop = TRUE])),
+          " failed because of non-missing values."
+        )
+      }
+
+      cns[[k]] <- as.character(rds[ids[[k]], "new", drop = TRUE])
+    }
+    colnames(weatherDF) <- cns
+  }
+
+  weatherDF
+}
+
 #' @return For [upgrade_weatherDF()]:
 #' an updated `weatherDF` with requested columns.
 #'
 #' @examples
 #' upgrade_weatherDF(
 #'   data.frame(DOY = 1:2, Tmax_C = runif(2), dummy = runif(2))
 #' )
+#' upgrade_weatherDF(
+#'   data.frame(DOY = 1:2, Tmax_C = runif(2), specHavg_pct = NA)
+#' )
 #'
 #' @md
 #' @rdname sw_upgrade
@@ -223,6 +301,8 @@ upgrade_weatherDF <- function(
     )
   )
 
+  weatherDF <- upgrade_weatherColumns(weatherDF)
+
   cns <- intersect(template_weatherColumns, colnames(weatherDF))
   if (length(cns) < 1L) stop("Required weather variables not found.")
   template_data[, cns] <- weatherDF[, cns]
@@ -275,6 +355,15 @@ weatherHistory <- function(weatherList = NULL) {
   }
 }
 
+validObject_weatherHistory <- function(object) {
+  res <- lapply(object, validObject)
+  has_msg <- vapply(res, is.character, FUN.VALUE = NA)
+  if (any(has_msg)) {
+    unlist(res[has_msg])
+  } else {
+    TRUE
+  }
+}
 
 #' @rdname swWeatherData-class
 #' @export

R/K_swContainer.R

@@ -232,7 +232,17 @@ swInputData <- function(...) {
 setValidity(
   "swInputData",
   function(object) {
-    res <- lapply(slotNames(object), function(sn) validObject(slot(object, sn)))
+    res <- lapply(
+      slotNames(object),
+      function(sn) {
+        if (identical(sn, "weatherHistory")) {
+          validObject_weatherHistory(slot(object, sn))
+        } else {
+          validObject(slot(object, sn))
+        }
+      }
+    )
+
     has_msg <- sapply(res, is.character)
     if (any(has_msg)) {
       unlist(res[has_msg])

R/swWeatherGenerator.R

@@ -1129,6 +1129,9 @@ compare_weather <- function(
 #' @inheritParams sw_weather_data
 #' @param years An integer vector. The calendar years for which to generate
 #' daily weather. If `NULL`, then extracted from `weatherData`.
+#' @param elevation A numeric value. Site elevation above sea level `[m]`.
+#'   Used only if specific humidity is provided as input
+#'   for calculating relative humidity.
 #' @param wgen_coeffs A list with two named elements `"mkv_doy"` and
 #' `"mkv_woy"`, i.e., the return value of [dbW_estimate_WGen_coefs()].
 #' If `NULL`, then [dbW_estimate_WGen_coefs()] is called on `weatherData`.
@@ -1210,6 +1213,7 @@ compare_weather <- function(
 dbW_generateWeather <- function(
   weatherData,
   years = NULL,
+  elevation = NA,
   wgen_coeffs = NULL,
   imputation_type = "mean",
   imputation_span = 5L,
@@ -1243,6 +1247,9 @@ dbW_generateWeather <- function(
   swYears_EndYear(sw_in) <- max(years)
   swYears_StartYear(sw_in) <- min(years)
 
+  # Set elevation
+  swSite_IntrinsicSiteParams(sw_in)[3L] <- as.numeric(elevation)
+
   # Turn on weather generator (to fill in missing values)
   swWeather_UseMarkov(sw_in) <- TRUE
   swWeather_UseMarkovOnly(sw_in) <- FALSE
@@ -1371,6 +1378,7 @@ dbW_imputeWeather <- function(
   seed = NULL,
   method_after_wg = c("interp", "locf", "mean", "none", "fail"),
   nmax_run = Inf,
+  elevation = NA,
   return_weatherDF = FALSE
 ) {
 
@@ -1402,6 +1410,7 @@ dbW_imputeWeather <- function(
     #--- Use weather generator for available variables
     tmp <- dbW_generateWeather(
       weatherData = weatherData,
+      elevation = elevation,
       return_weatherDF = TRUE,
       seed = seed
     )
@@ -1717,16 +1726,16 @@ dbW_fixWeather <- function(
   tmp <- which(rowSums(!is_miss1) > 0L)
   ids <- tmp[c(1L, length(tmp))]
 
-  ids_startend <-
+  ids_startend <- if (length(tmp) > 0L) {
     # before start
     (weatherData1[["Year"]] < weatherData1[ids[[1L]], "Year"]) |
-    (weatherData1[["Year"]] == weatherData1[ids[[1L]], "Year"] &
-        weatherData1[["DOY"]] < weatherData1[ids[[1L]], "DOY"]) |
-    # after end
-    (weatherData1[["Year"]] == weatherData1[ids[[2L]], "Year"] &
-        weatherData1[["DOY"]] > weatherData1[ids[[2L]], "DOY"]) |
-    (weatherData1[["Year"]] > weatherData1[ids[[2L]], "Year"])
-
+      (weatherData1[["Year"]] == weatherData1[ids[[1L]], "Year"] &
+          weatherData1[["DOY"]] < weatherData1[ids[[1L]], "DOY"]) |
+      # after end
+      (weatherData1[["Year"]] == weatherData1[ids[[2L]], "Year"] &
+          weatherData1[["DOY"]] > weatherData1[ids[[2L]], "DOY"]) |
+      (weatherData1[["Year"]] > weatherData1[ids[[2L]], "Year"])
+  }
 
 
   #--- Interpolate short missing runs