Development for v6.0.4 (#243)

* New `upgrade_weatherDF()` adds requested weather columns to a data frame (@dschlaep).
* Improved rounding of weather functionality (@dschlaep):
    * `dbW_weatherData_round()` now rounds both `"weatherList"` and `"weatherDF"` objects; argument `"digits"` can now also be logical (if `TRUE`, then digits takes the default value of 4) or not finite (e.g., `NA`; not finite values return the input without rounding).
    * Argument `"round"` of `dbW_dataframe_to_weatherData()` is deprecated and changed the default value from rounding to 2 digits to no rounding (`NA`); recommended replacement is a separate call to `dbW_weatherData_round()`.
    * Argument `"digits"` of `dbW_generateWeather()` changed the default value from rounding to 4 digits to no rounding (`NA`).
* `dbW_generateWeather()` gained `"return_weatherDF"` and now returns a user requested weather object type (@dschlaep). If `return_weatherDF` is `TRUE`, then the result is converted to a data frame where columns represent weather variables; otherwise, a list of elements of class `swWeatherData` is returned (as previously).
* New `dbW_imputeWeather()` replaces missing weather values using using the weather generator and using functionality by `rSW2utils::impute_df()` (@dschlaep).
* New `dbW_substituteWeather()` replaces missing weather values in one weather data object with values from a second weather data object (@dschlaep).
* New `dbW_fixWeather()` fixes missing weather values using a sequence of approaches including linear interpolation for short missing spells, a fixed value for short spells of missing precipitation (optionally), substitution from a second weather data object, and replacement with long term daily mean values (@dschlaep).
* New family of functions `sw_meteo_obtain` that obtain (download) weather data from external sources and prepare for use by `"rSOILWAT2"` (@dschlaep):
      * New `sw_meteo_obtain_DayMet()` obtains and formats data from `"Daymet"`
      * New `sw_meteo_obtain_SCAN()` obtains and formats data from `"SCAN"`

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: rSOILWAT2
-Version: 6.0.3
+Version: 6.0.4
 Title: An Ecohydrological Ecosystem-Scale Water Balance Simulation Model
 Description: Access to the C-based SOILWAT2 v7.2.0 and functionality for
   SQLite-database of weather data.

NAMESPACE

@@ -44,6 +44,7 @@ export(dbW_deleteSiteData)
 export(dbW_delete_duplicated_weatherData)
 export(dbW_disconnectConnection)
 export(dbW_estimate_WGen_coefs)
+export(dbW_fixWeather)
 export(dbW_generateWeather)
 export(dbW_getIDs)
 export(dbW_getScenarioId)
@@ -57,7 +58,9 @@ export(dbW_has_siteIDs)
 export(dbW_has_sites)
 export(dbW_has_weatherData)
 export(dbW_have_sites_all_weatherData)
+export(dbW_imputeWeather)
 export(dbW_setConnection)
+export(dbW_substituteWeather)
 export(dbW_updateSites)
 export(dbW_upgrade_to_rSOILWAT2)
 export(dbW_upgrade_v1to2)
@@ -138,6 +141,8 @@ export(sw_dailyC4_TempVar)
 export(sw_exec)
 export(sw_inputData)
 export(sw_inputDataFromFiles)
+export(sw_meteo_obtain_DayMet)
+export(sw_meteo_obtain_SCAN)
 export(sw_out_flags)
 export(sw_outputData)
 export(sw_verbosity)
@@ -148,6 +153,7 @@ export(swrc_vwc_to_swp)
 export(time_columns)
 export(update_biomass)
 export(update_requested_years)
+export(upgrade_weatherDF)
 export(upgrade_weatherHistory)
 export(weatherGenerator_dataColumns)
 export(weatherHistory)

NEWS.md

@@ -1,3 +1,40 @@
+# rSOILWAT2 v6.0.4
+* This version produces the same output as the previous version.
+
+## New features
+* New `upgrade_weatherDF()` adds requested weather columns to a data frame
+  (@dschlaep).
+* Improved rounding of weather functionality (@dschlaep):
+    * `dbW_weatherData_round()` now rounds both `"weatherList"` and
+      `"weatherDF"` objects; argument `"digits"` can now also be logical
+      (if `TRUE`, then digits takes the default value of 4) or not finite
+      (e.g., `NA`; not finite values return the input without rounding).
+    * Argument `"round"` of `dbW_dataframe_to_weatherData()` is deprecated and
+      changed the default value from rounding to 2 digits to no rounding (`NA`);
+      recommended replacement is a separate call to `dbW_weatherData_round()`.
+    * Argument `"digits"` of `dbW_generateWeather()` changed the default value
+      from rounding to 4 digits to no rounding (`NA`).
+* `dbW_generateWeather()` gained `"return_weatherDF"` and now returns a
+  user requested weather object type (@dschlaep).
+  If `return_weatherDF` is `TRUE`, then the result is converted to a
+  data frame where columns represent weather variables; otherwise,
+  a list of elements of class `swWeatherData` is returned (as previously).
+* New `dbW_imputeWeather()` replaces missing weather values using
+  using the weather generator and
+  using functionality by `rSW2utils::impute_df()` (@dschlaep).
+* New `dbW_substituteWeather()` replaces missing weather values in one
+  weather data object with values from a second weather data object (@dschlaep).
+* New `dbW_fixWeather()` fixes missing weather values using a sequence of
+  approaches including linear interpolation for short missing spells,
+  a fixed value for short spells of missing precipitation (optionally),
+  substitution from a second weather data object, and
+  replacement with long term daily mean values (@dschlaep).
+* New family of functions `sw_meteo_obtain` that obtain (download) weather
+  data from external sources and prepare for use by `"rSOILWAT2"` (@dschlaep):
+      * New `sw_meteo_obtain_DayMet()` obtains and formats data from `"Daymet"`
+      * New `sw_meteo_obtain_SCAN()` obtains and formats data from `"SCAN"`
+
+
 # rSOILWAT2 v6.0.3
 * This version produces the same output as the previous version.
 * Update `SOILWAT2` to v7.2.0 which improves error handling and fixes

R/A_swGenericMethods.R

@@ -137,7 +137,7 @@ check_version <- function(
       expected[[c(1, 3)]] <- 0
     }
 
-    if (level %in% "major") {
+    if (identical(level, "major")) {
       # zero the minor-level
       has[[c(1, 2)]] <- 0
       expected[[c(1, 2)]] <- 0
@@ -230,7 +230,7 @@ format_timestamp <- function(object) {
 #'         `"SWA"` added as `outkey` 8 for a new total of 30
 #'
 #' @examples
-#'   x <- sw_upgrade(rSOILWAT2::sw_exampleData, verbose = TRUE)
+#' x <- sw_upgrade(rSOILWAT2::sw_exampleData, verbose = TRUE)
 #'
 #' @md
 #' @exportMethod sw_upgrade

R/B_swFiles.R

@@ -143,7 +143,7 @@ setMethod(
     # Maintenance:
     #   update `do_upgrade` when `n_exp` changes or new upgrades required!
     do_upgrade <- c(
-      from_v230 = n_has == 22L && n_exp %in% 23L
+      from_v230 = n_has == 22L && n_exp == 23L
     )
 
     do_upgrade <- do_upgrade[do_upgrade]

R/D_swCloud.R

@@ -145,12 +145,12 @@ swCloud <- function(...) {
   # We don't set values for slot `Cloud` (except SnowDensity and RainEvents)
   # if not passed via ...; this is to prevent simulation runs with
   # accidentally incorrect values
-  if (!("Cloud" %in% dns)) {
-    ids <- 4:5
-    def@Cloud[- ids, ] <- NA_real_
-  } else {
+  if ("Cloud" %in% dns) {
     # Guarantee names
     dimnames(dots[["Cloud"]]) <- dimnames(def@Cloud)
+  } else {
+    ids <- 4:5
+    def@Cloud[- ids, ] <- NA_real_
   }
 
   tmp <- lapply(

R/D_swWeather.R

@@ -133,12 +133,12 @@ sw_upgrade_MonthlyScalingParams <- function( # nolint: object_length_linter.
   vars_exp <- colnames(default@MonthlyScalingParams)
   vars_has <- colnames(MonthlyScalingParams)
 
-  if (!all(vars_exp %in% vars_has)) {
+  if (all(vars_exp %in% vars_has)) {
+    MonthlyScalingParams
+  } else {
     res <- default@MonthlyScalingParams
     res[, vars_has] <- MonthlyScalingParams[, vars_has]
     res
-  } else {
-    MonthlyScalingParams
   }
 }
 
@@ -243,7 +243,7 @@ setValidity(
     sns <- setdiff(slotNames("swWeather"), inheritedSlotNames("swWeather"))
 
     for (sn in sns) {
-      n_exp <- if (sn %in% "dailyInputFlags") {
+      n_exp <- if (identical(sn, "dailyInputFlags")) {
         rSW2_glovars[["kSOILWAT2"]][["kINT"]][["MAX_INPUT_COLUMNS"]]
       } else {
         1L

R/D_swWeatherData.R

@@ -44,20 +44,20 @@ weather_dataColumns <- function() {
 #' @export
 weather_dataAggFun <- function() {
   c(
-    "Tmax_C" = mean,
-    "Tmin_C" = mean,
-    "PPT_cm" = sum,
-    "cloudCov_pct" = mean,
-    "windSpeed_mPERs" = mean,
-    "windSpeed_east_mPERs" = mean,
-    "windSpeed_north_mPERs" = mean,
-    "rHavg_pct" = mean,
-    "rHmax_pct" = mean,
-    "rHmin_pct" = mean,
-    "specHavg_pct" = mean,
-    "Tdewpoint_C" = mean,
-    "actVP_kPa" = mean,
-    "shortWR" = mean
+    Tmax_C = mean,
+    Tmin_C = mean,
+    PPT_cm = sum,
+    cloudCov_pct = mean,
+    windSpeed_mPERs = mean,
+    windSpeed_east_mPERs = mean,
+    windSpeed_north_mPERs = mean,
+    rHavg_pct = mean,
+    rHmax_pct = mean,
+    rHmin_pct = mean,
+    specHavg_pct = mean,
+    Tdewpoint_C = mean,
+    actVP_kPa = mean,
+    shortWR = mean
   )
 }
 
@@ -188,12 +188,42 @@ 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_weatherDF()]:
+#' an updated `weatherDF` with requested columns.
+#'
+#' @examples
+#' upgrade_weatherDF(
+#'   data.frame(DOY = 1:2, Tmax_C = runif(2), dummy = runif(2))
+#' )
+#'
+#' @md
+#' @rdname sw_upgrade
+#' @export
+upgrade_weatherDF <- function(
+  weatherDF,
+  template_weatherColumns = c("Year", "DOY", weather_dataColumns())
+) {
+  template_data <- as.data.frame(
+    array(
+      dim = c(nrow(weatherDF), length(template_weatherColumns)),
+      dimnames = list(NULL, template_weatherColumns)
+    )
+  )
+
+  cns <- intersect(template_weatherColumns, colnames(weatherDF))
+  if (length(cns) < 1L) stop("Required weather variables not found.")
+  template_data[, cns] <- weatherDF[, cns]
+  template_data
+}
 
 upgrade_swWeatherData <- function(data, year, template = new("swWeatherData")) {
-  stopifnot(colnames(data) %in% colnames(template@data))
   template@year <- as.integer(year)
-  template@data <- template@data[seq_len(nrow(data)), , drop = FALSE]
-  template@data[, colnames(data)] <- data
+  template@data <- data.matrix(
+    upgrade_weatherDF(data, c("DOY", weather_dataColumns()))
+  )
   template
 }
 

R/F_swSite.R

@@ -211,14 +211,14 @@ swSite <- function(...) {
     tmp <- c("Longitude", "Latitude", "Altitude", "Slope", "Aspect")
     def@IntrinsicSiteParams[tmp] <- NA_real_
   }
-  if (!("TranspirationRegions" %in% dns)) {
-    def@TranspirationRegions[, "layer"] <- NA_integer_
-  } else {
+  if ("TranspirationRegions" %in% dns) {
     # Guarantee names
     dimnames(dots[["TranspirationRegions"]]) <- list(
       NULL,
       colnames(def@TranspirationRegions)
     )
+  } else {
+    def@TranspirationRegions[, "layer"] <- NA_integer_
   }
 
   if ("swrc_flags" %in% dns) {

R/F_swSoils.R

@@ -185,24 +185,24 @@ swSoils <- function(...) {
 
   # We don't set values for slot `Layers` if not passed via ...; this
   # is to prevent simulation runs with accidentally incorrect values
-  if (!("Layers" %in% dns)) {
-    def@Layers <- def@Layers[1, , drop = FALSE]
-    def@Layers[] <- NA_real_
-    ntmp <- 1
-  } else {
+  if ("Layers" %in% dns) {
     # Guarantee names
     dimnames(dots[["Layers"]]) <- list(NULL, colnames(def@Layers))
     ntmp <- nrow(dots[["Layers"]])
+  } else {
+    def@Layers <- def@Layers[1, , drop = FALSE]
+    def@Layers[] <- NA_real_
+    ntmp <- 1
   }
 
   # We don't set values for slot `SWRCp` if not passed via ...; this
   # is to prevent simulation runs with accidentally incorrect values
-  if (!("SWRCp" %in% dns)) {
-    def@SWRCp <- def@SWRCp[rep.int(1, ntmp), , drop = FALSE]
-    def@SWRCp[] <- NA_real_
-  } else {
+  if ("SWRCp" %in% dns) {
     # Guarantee names
     dimnames(dots[["SWRCp"]]) <- list(NULL, colnames(def@SWRCp))
+  } else {
+    def@SWRCp <- def@SWRCp[rep.int(1, ntmp), , drop = FALSE]
+    def@SWRCp[] <- NA_real_
   }
 
   # Copy from SOILWAT2 "testing" (defaults), but dot arguments take precedence

R/G_swOut.R

@@ -281,7 +281,7 @@ setMethod(
     #   update `do_upgrade` when `n_exp` changes or new upgrades required!
     do_upgrade <- c(
       from_v230 = n_has == 30L && n_exp %in% 31L:32L,
-      from_v310 = n_has == 31L && n_exp %in% 32L
+      from_v310 = n_has == 31L && n_exp == 32L
     )
 
     do_upgrade <- do_upgrade[do_upgrade]

R/Rsw.R

@@ -502,15 +502,8 @@ set_requested_flags <- function(swIn, tag, use, values, fun, reset = TRUE,
       # Check dimensional agreement
       ndim_gt1_vals <- sum(dim(data.frame(vals)) > 1)
       ndim_gt1_def <- sum(dim(data.frame(def)) > 1)
-      if (!(ndim_gt1_vals == 1 && ndim_gt1_def == 1)) {
-        stop(
-          "ERROR: ",
-          toString(shQuote(val_names)),
-          " are not represented as 1-dimensional objects in",
-          " class 'swInputData'."
-        )
 
-      } else {
+      if (ndim_gt1_vals == 1 && ndim_gt1_def == 1) {
         # Transfer values
         itemp <- sapply(names(def), function(x) {
           k <- grep(substr(x, 1, 4), val_names)
@@ -522,6 +515,14 @@ set_requested_flags <- function(swIn, tag, use, values, fun, reset = TRUE,
         }
 
         swIn <- get(paste0(fun, "<-"))(swIn, def)
+
+      } else {
+        stop(
+          "ERROR: ",
+          toString(shQuote(val_names)),
+          " are not represented as 1-dimensional objects in",
+          " class 'swInputData'."
+        )
       }
     }
   }