Rename weather variable "specHavg_pct" to "specHavg_gPERkg"

- update package data: only difference is the updated name of the weather data column for specific humidity
- update test data: only difference is the updated name of the weather data column for specific humidity

- rename specific humidity: weather_dataColumns() and weather_dataAggFun()
* dbW_weatherData_to_monthly() and dbW_dataframe_aggregate() are now more careful with weather data column names

- functionality to upgrade old weather data:
* new weather_renamedDataColumns() identifies renaming of weather data columns
* new upgrade_weatherColumns() applies renaming of weather data columns
* upgrade_weatherDF() now calls upgrade_weatherColumns() -- satisfying sw_upgrade(), upgrade_swWeatherData(), and upgrade_weatherHistory()

- updated functionality to test validity:
* validObject() method for class "swWeatherData" now checks for expected column names in the "data" slot
* new validObject_weatherHistory() to check for validity of a weatherHistory object
* validObject() method for class "swInputData" now checks for a valid weatherHistory object -- previously weatherHistory was skipped

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,8 +1,15 @@
 # rSOILWAT2 v6.2.0-9000
 
+* `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.

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`]

R/D_swWeatherData.R

@@ -32,12 +32,27 @@ 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
+    )
+  )
+}
+
 #' Functions to summarize currently implemented daily weather variables
 #' @return A named vector of functions that summarize
 #' daily weather variables across time.
@@ -54,7 +69,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 +105,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 +172,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 +229,61 @@ 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 (any(!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])) {
+        if (!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 +299,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 +353,15 @@ weatherHistory <- function(weatherList = NULL) {
   }
 }
 
+validObject_weatherHistory <- function(object) {
+  res <- lapply(object, function(x) validObject(x))
+  has_msg <- sapply(res, is.character)
+  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/sw_dbW_WeatherDatabase.R

@@ -2254,7 +2254,12 @@ dbW_weatherData_to_monthly <- function(
   valNA = NULL,
   funs = weather_dataAggFun()
 ) {
-  vars <- names(funs)
+  tmpv <- if (length(dailySW) > 0L) {
+    colnames(dailySW[[1L]]@data)
+  } else {
+    weather_dataColumns()
+  }
+  vars <- intersect(names(funs), tmpv)
 
   monthly <- matrix(
     nrow = length(dailySW) * 12,
@@ -2330,7 +2335,7 @@ dbW_dataframe_aggregate <- function(
     )
   }
 
-  vars <- names(funs)
+  vars <- intersect(names(funs), colnames(dailySW))
 
   res <- as.matrix(
     cbind(

src/rSW_Weather.c

@@ -343,7 +343,7 @@ SEXP onGet_WTH_DATA(void) {
   Daily weather elements that are not internally stored by `SOILWAT2` are
   returned as missing values; these are
   `"windSpeed_east_mPERs"`, `"windSpeed_north_mPERs"`,
-  `"rHmax_pct"`, `"rHmin_pct"`, `"specHavg_pct"`, `"Tdewpoint_C"`
+  `"rHmax_pct"`, `"rHmin_pct"`, `"specHavg_gPERkg"`, `"Tdewpoint_C"`
 
   Called by `onGet_WTH_DATA()`
 */
@@ -359,7 +359,7 @@ SEXP onGet_WTH_DATA_YEAR(TimeInt year) {
 		"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"
 	};

tests/testthat/test_Upgrade_rSOILWAT_S4_classes.R

@@ -72,4 +72,26 @@ test_that("Upgrade old rSOILWAT2 weather objects", {
       )
     )
   }
+
+
+  #--- upgrade_weatherColumns
+  expect_named(
+    upgrade_weatherColumns(
+      data.frame(DOY = 1:2, Tmax_C = runif(2), dummy = runif(2))
+    ),
+    c("DOY", "Tmax_C", "dummy")
+  )
+
+  expect_named(
+    upgrade_weatherColumns(
+      data.frame(DOY = 1:2, Tmax_C = runif(2), specHavg_pct = NA)
+    ),
+    c("DOY", "Tmax_C", "specHavg_gPERkg")
+  )
+
+  expect_error(
+    upgrade_weatherColumns(
+      data.frame(DOY = 1:2, Tmax_C = runif(2), specHavg_pct = runif(2))
+    )
+  )
 })

tests/testthat/test_WeatherData.R

@@ -31,6 +31,13 @@ test_that("Weather data check", {
     get_WeatherHistory(rSOILWAT2::sw_exampleData)
   ))
   expect_true(dbW_check_weatherData(weatherHistory(), check_all = FALSE))
+
+  expect_true(
+    validObject_weatherHistory(get_WeatherHistory(rSOILWAT2::sw_exampleData))
+  )
+  expect_true(validObject_weatherHistory(rSOILWAT2::weatherData))
+  expect_true(validObject_weatherHistory(list(swWeatherData())))
+  expect_true(validObject_weatherHistory(NULL))
 })
 
 test_that("Missing weather data", {