Merge pull request #195 from DrylandEcology/feature_identify_MinAvgMa…

…xSoilTemp

Extract average soil and surface temperature consistently

* v5.3.0 changed the names of soil and surface temperature output
* new `get_soiltemp_avg()` and `get_surfacetemp_avg()` provide an consistent interface across versions

NAMESPACE

@@ -72,6 +72,8 @@ export(format_timestamp)
 export(getStartYear)
 export(getWeatherData_folders)
 export(get_evaporation)
+export(get_soiltemp_avg)
+export(get_surfacetemp_avg)
 export(get_timestamp)
 export(get_transpiration)
 export(get_version)

NEWS.md

@@ -1,4 +1,12 @@
 # rSOILWAT2 v5.3.1-9000
+* New `get_soiltemp_avg()` extracts average soil temperature from simulation
+  output.
+* New `get_surfacetemp_avg()` extracts average soil surface temperature
+  from simulation output.
+* These functions work with rSOILWAT2 versions before and after `v5.3.0`
+  which changed column names of average soil temperature from
+  `Lyr_X` to `Lyr_X_avg_C` and of average soil surface temperature from
+  `surfaceTemp_C` to `surfaceTemp_avg_C`.
 
 
 # rSOILWAT2 v5.3.0

R/sw_OutputDerived_Functions.R

@@ -95,3 +95,92 @@ get_evaporation <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
   # convert [cm] to [mm]
   10 * res
 }
+
+
+#' Extract average soil temperature
+#'
+#' @inheritParams get_derived_output
+#'
+#' @return A numeric matrix of soil temperature [C] for each time step
+#'   at depth of each soil layer.
+#'
+#' @examples
+#' sw_out <- sw_exec(inputData = rSOILWAT2::sw_exampleData)
+#' get_soiltemp_avg(sw_out, "Month")
+#'
+#' @export
+get_soiltemp_avg <- function(x, timestep = c("Day", "Week", "Month", "Year")) {
+  timestep <- match.arg(timestep)
+
+  tmp <- slot(slot(x, sw_out_flags()["sw_soiltemp"]), timestep)
+
+  res <- NULL
+
+  if (nrow(tmp) > 0) {
+    # soil temperature output was produced
+    cns_sl <- grep("Lyr_", colnames(tmp), fixed = TRUE, value = TRUE)
+    cns_avg <- grep("Lyr_[[:digit:]]+_avg_C", cns_sl, value = TRUE)
+
+    res <- if (length(cns_avg) > 0) {
+      # rSOILWAT2 since v5.3.0: `Lyr_1_max_C`, `Lyr_1_min_C`, `Lyr_1_avg_C`, ...
+      tmp[, cns_avg, drop = FALSE]
+    } else {
+      # rSOILWAT2 before v5.3.0: `Lyr_1`, ...
+      tmp[, cns_sl, drop = FALSE]
+    }
+
+  } else {
+    stop(
+      "Simulation run without producing soil temperature output: ",
+      "consider turning on output key ",
+      shQuote(sw_out_flags()["sw_soiltemp"]),
+      "."
+    )
+  }
+
+  res
+}
+
+
+#' Extract average soil surface temperature
+#'
+#' @inheritParams get_derived_output
+#'
+#' @return A numeric vector of soil surface temperature [C] for each time step.
+#'
+#' @examples
+#' sw_out <- sw_exec(inputData = rSOILWAT2::sw_exampleData)
+#' get_surfacetemp_avg(sw_out, "Month")
+#'
+#' @export
+get_surfacetemp_avg <- function(
+  x,
+  timestep = c("Day", "Week", "Month", "Year")
+) {
+  timestep <- match.arg(timestep)
+
+  tmp <- slot(slot(x, sw_out_flags()["sw_temp"]), timestep)
+
+  res <- NULL
+
+  if (nrow(tmp) > 0) {
+    # surface temperature output was produced
+    res <- if ("surfaceTemp_C" %in% colnames(tmp)) {
+      # rSOILWAT2 before v5.3.0
+      tmp[, "surfaceTemp_C"]
+    } else if ("surfaceTemp_avg_C" %in% colnames(tmp)) {
+      # rSOILWAT2 since v5.3.0
+      tmp[, "surfaceTemp_avg_C"]
+    }
+
+  } else {
+    stop(
+      "Simulation run without producing surface temperature output: ",
+      "consider turning on output key ",
+      shQuote(sw_out_flags()["sw_temp"]),
+      "."
+    )
+  }
+
+  res
+}

tests/testthat/test_OutputDerived.R

@@ -6,16 +6,52 @@ test_that("Derived output: transpiration and evaporation", {
   sw_in <- rSOILWAT2::sw_exampleData
 
   # With 'AET' output activated
-  tran1 <- get_transpiration(sw_exec(inputData = sw_in), "Month")
-  evap1 <- get_evaporation(sw_exec(inputData = sw_in), "Month")
+  sw_out1 <- sw_exec(inputData = sw_in)
+  tran1 <- get_transpiration(sw_out1, "Month")
+  evap1 <- get_evaporation(sw_out1, "Month")
 
   # De-activate 'AET' output and re-calculated from 'TRANSP'
-  deactivate_swOUT_OutKey(sw_in) <- "AET"
-  tran2 <- get_transpiration(sw_exec(inputData = sw_in), "Month")
-  evap2 <- get_evaporation(sw_exec(inputData = sw_in), "Month")
+  deactivate_swOUT_OutKey(sw_in) <- sw_out_flags()["sw_aet"]
+  sw_out2 <- sw_exec(inputData = sw_in)
+  tran2 <- get_transpiration(sw_out2, "Month")
+  evap2 <- get_evaporation(sw_out2, "Month")
 
 
   # Output should be the same either way
   expect_equal(tran1, tran2)
   expect_equal(evap1, evap2)
 })
+
+
+test_that("Derived output: average soil/surface temperature", {
+  sw_in <- rSOILWAT2::sw_exampleData
+  n_soillayers <- nrow(swSoils_Layers(sw_in))
+
+  # With 'SOILTEMP' output activated
+  sw_out1 <- sw_exec(inputData = sw_in)
+
+  st_avg1 <- get_soiltemp_avg(sw_out1, "Month")
+  expect_equal(nrow(st_avg1), slot(sw_out1, "mo_nrow"))
+  expect_equal(ncol(st_avg1), n_soillayers)
+
+  sf_avg1 <- get_surfacetemp_avg(sw_out1, "Month")
+  expect_length(sf_avg1, slot(sw_out1, "mo_nrow"))
+
+
+  # With 'SOILTEMP' output de-activated
+  deactivate_swOUT_OutKey(sw_in) <- sw_out_flags()["sw_soiltemp"]
+  sw_out2 <- sw_exec(inputData = sw_in)
+
+  expect_error(get_soiltemp_avg(sw_out2, "Month"))
+
+  sf_avg2 <- get_surfacetemp_avg(sw_out2, "Month")
+  expect_length(sf_avg2, slot(sw_out2, "mo_nrow"))
+
+
+  # WITH 'TEMP' output de-activated
+  deactivate_swOUT_OutKey(sw_in) <- sw_out_flags()["sw_temp"]
+  sw_out3 <- sw_exec(inputData = sw_in)
+
+  expect_error(get_soiltemp_avg(sw_out3, "Month"))
+  expect_error(get_surfacetemp_avg(sw_out3, "Month"))
+})