Weather and ManagementData input checking + tests

.github/workflows/R-CMD-check.yaml

@@ -2,9 +2,9 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master]
+    branches: [main, master, dev]
   pull_request:
-    branches: [main, master]
+    branches: [main, master, dev]
 
 name: R-CMD-check
 

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: growR
 Type: Package
-Version: 1.0.0.9007
+Version: 1.0.0.9008
 Date: 2023-09-27
 Authors@R: person(
     given = "Kevin",

NEWS.md

@@ -2,6 +2,11 @@
 
 ## Added
 
+* Input integrity checking for WeatherData and ManagementData.
+
+* PScanPlotter (`plot_parameter_scan`) now allows to select which variable to 
+  display (from dBM, cBM and cBM_tot).
+
 * Instances where simulation results for variable `dBM` are visualized or 
   compared to experimental data now allow specifying and integration window 
   for `dBM`, which should be set to match the experimental reality. This 

R/management.R

@@ -58,6 +58,9 @@ ManagementData = R6Class(
         logger(sprintf("Loading management data from %s.", management_file), 
                level = DEBUG)
         cut_data = read.table(management_file, header = TRUE)
+        # Carry out basic input checks
+        self$ensure_file_integrity(cut_data)
+
         # Only consider specified years
         if (is.null(years)) {
           selector = TRUE
@@ -89,6 +92,30 @@ ManagementData = R6Class(
       }
     },
 
+    #' @description Check that all required columns are present and that cut 
+    #' DOYs are only increasing in a given year.
+    #'
+    #' @param cut_data data.frame containing the cut data.
+    #'
+    ensure_file_integrity = function(cut_data) {
+      required = c("year", "DOY")
+      data_name = sprintf("the supplied management file `%s`", 
+                          self$management_file)
+      ensure_table_columns(required, cut_data, data_name = data_name)
+
+      # EnsureDOYs are always increasing within a year.
+      for (year in unique(cut_data$year)) {
+        this_years_DOYs = cut_data[cut_data$year == year,]$DOY
+#        monotonic = all(cummax(this_years_DOYs) == this_years_DOYs)
+        not_monotonic = is.unsorted(this_years_DOYs, strictly = TRUE)
+        if (not_monotonic) {
+          msg = paste("DOYs are not monotonically increasing in year %s in",
+                      "supplied management file `%s`.")
+          logger(sprintf(msg, year, self$management_file), level = ERROR)
+        }
+      }
+    },
+
     #' @description Extract management data for given year
     #'
     #' This simply filters out all data not matching *year* and returns a 

R/parameter_scan.R

@@ -362,8 +362,9 @@ PscanPlotter = R6Class(
     plot = function() {
       # Create new graphics device
       if (is.null(private$device_number)) {
-        dev.new()
-        private$device_number = dev.cur()
+#        dev.new()
+        device_number = dev.cur()
+        private$device_number = ifelse(device_number == 1, 2, device_number)
       } else {
         dev.set(private$device_number)
       }

R/parameters.R

@@ -231,7 +231,6 @@ ModvegeParameters = R6Class(
       },
 
       #' @description Parameter Sanity Check
-      #'
       #' Ensure that the supplied *params* are valid ModVege parameters and, 
       #' if requested, check that all required parameters are present.
       #' Issues a warning for any invalid parameters and throws an error if 
@@ -248,15 +247,7 @@ ModvegeParameters = R6Class(
       #'
       #' @md
       check_parameters = function(param_names, check_for_completeness = TRUE) {
-        not_known = setdiff(param_names, self$parameter_names)
         param_file = self$param_file
-        # Warn if some arguments were not recognized.
-        if (length(not_known) != 0) {
-          unknown_args = paste(not_known, collapse = "\n")
-          msg = paste("The following unrecognized parameters were present",
-                      "in the supplied input file (%s):\n%s")
-          logger(sprintf(msg, param_file, unknown_args), level = WARNING)
-        }
         if (check_for_completeness) {
           # Give error if an argument is missing.
           not_present = setdiff(self$required_parameter_names, param_names)
@@ -268,6 +259,15 @@ ModvegeParameters = R6Class(
             logger(sprintf(msg, param_file, missing_args), level = ERROR)
           }
         }
+
+        not_known = setdiff(param_names, self$parameter_names)
+        # Warn if some arguments were not recognized.
+        if (length(not_known) != 0) {
+          unknown_args = paste(not_known, collapse = "\n")
+          msg = paste("The following unrecognized parameters were present",
+                      "in the supplied input file (%s):\n%s")
+          logger(sprintf(msg, param_file, unknown_args), level = WARNING)
+        }
         return(not_known)
       }
     )

R/utilities.R

@@ -351,3 +351,25 @@ box_smooth = function(x, box_width = 28) {
   return(x_smooth)
 }
 
+#' Check if supplied table contains all *required* variables.
+#'
+#' Logs an error if any variable is missing and lists the missing variables 
+#' in the error message along with *data_name*.
+#'
+#' @param required List of names of required variables.
+#' @param data data.frame or similar object to be checked.
+#' @param data_name Name to be displayed in the error message if any variable 
+#'   is missing.
+#'
+ensure_table_columns = function(required, data, data_name = "the data table") {
+  found = names(data)
+  not_present = setdiff(required, found)
+  if (length(not_present) != 0) {
+    # Construct the error message.
+    missing_args = paste(not_present, collapse = "\n")
+    msg = paste("The following parameters were missing",
+                "from %s:\n%s")
+    logger(sprintf(msg, data_name, missing_args), level = ERROR)
+  }
+}
+

R/weather.R

@@ -87,8 +87,8 @@ WeatherData = R6Class(
     #'   Default (NULL) is to read in all found years.
     #'
     read_weather = function(weather_file, years = NULL) {
-      self$years = years
       self$weather_file = weather_file
+      self$years = years
       # Load weather data
       if (file.exists(weather_file)) {
         logger(sprintf("Loading weather data from %s.", weather_file), 
@@ -97,8 +97,7 @@ WeatherData = R6Class(
         stop(sprintf("Weather file `%s` not found.", weather_file))
       }
       weather = read.table(weather_file, header = TRUE)
-      # Hard fix NA values
-      weather[is.na(weather)] = 0.0
+      weather = self$ensure_file_integrity(weather)
 
       # Only consider relevant years and omit leap days
       selector = weather$DOY < 366
@@ -188,6 +187,22 @@ WeatherData = R6Class(
       self[["Ta_smooth"]] = Ta_smooth
     },
 
+    #' @description Check if supplied input file is formatted correctly.
+    #'
+    #' Check if required column names are present and fix NA entries.
+    #'
+    #' @param weather data.table of the read input file with `header = TRUE`.
+    #'
+    ensure_file_integrity = function(weather) {
+      required = c("year", "DOY", "Ta", "precip", "PAR", "ET0")
+      data_name = sprintf("the supplied weather file `%s`", self$weather_file)
+      ensure_table_columns(required, weather, data_name = data_name)
+
+      # Hard fix NA values
+      weather[is.na(weather)] = 0.0
+      return(weather)
+    },
+
     #' @description Calculate the expected length of day based on a site's 
     #' geographical latitude.
     #'

tests/testthat/_snaps/management/weather_example_values.dat

@@ -0,0 +1 @@
+

tests/testthat/_snaps/weather/management_example_values.dat

@@ -0,0 +1 @@
+

tests/testthat/test-management.R

@@ -0,0 +1,42 @@
+## Write all non-function field values to a file
+save_temp_output = function(W) {
+  path1 = tempfile(fileext = ".dat")
+
+  tab = data.frame(year = W$year, DOY = W$DOY, Ta = W$Ta, precip = W$precip, 
+                   PAR = W$PAR, ET0 = W$ET0)
+  write.table(tab, file = path1, quote = FALSE)
+  return(path1)
+}
+
+test_that("WeatherData read example data", {
+  wd_default_snapshot = "weather_example_values.dat"
+  announce_snapshot_file(wd_default_snapshot)
+
+  extdata = system.file("extdata", package = "growR")
+  example_weather_file = file.path(extdata, "posieux_weather.txt")
+  W = WeatherData$new(example_weather_file)
+
+  path = save_temp_output(W)
+  expect_snapshot_file(path, wd_default_snapshot, compare = compare_file_text)
+})
+
+test_that("WeatherData input checking", {
+  # Store old options for resetting after test
+  old_opts = options()
+  on.exit(options(old_opts))
+  set_growR_verbosity(5)
+
+  W = WeatherData$new()
+  W$weather_file = "<testthat>"
+
+  incomplete_data = data.frame(year = 1)
+  expect_error(W$ensure_file_integrity(incomplete_data),
+               regexp = "parameters were missing")
+
+  # NA correction
+  na_data = data.frame(year = 1, DOY = 1, Ta = NA, precip = NA, PAR = NA, 
+                       ET0 = NA)
+  checked_data = W$ensure_file_integrity(na_data)
+  expect_false(any(is.na(checked_data)))
+
+})

tests/testthat/test-weather.R

@@ -1,16 +1,45 @@
-test_that("Reading of weather data", {
-  datapath = system.file("extdata", package = "growR")
-  weather_file = file.path(datapath, "posieux_weather.txt")
-  WD = WeatherData$new(weather_file)
-  expect_false(is.null(WD$years))
-  W = WD$get_weather_for_year(WD$years[1])
-  # Check that none of the important keys are NULL
-  keys = c("aCO2", "year", "DOY", "Ta", "Ta_sm", "PAR", "PP", "PET", 
-           "liquidP", "melt", "snow", "ndays")
-  for (key in keys) {
-    if (is.null(W[[key]])) {
-      logger(sprintf("Weather variable is NULL: %s.", key), level = 2)
-    }
-    expect_false(is.null(W[[key]]))
-  }
+## Write all non-function field values to a file
+save_temp_output = function(M) {
+  path1 = tempfile(fileext = ".dat")
+
+  tab = data.frame(year = M$year, DOY = M$DOY)
+  write.table(tab, file = path1, quote = FALSE)
+  return(path1)
+}
+
+test_that("ManagementData read example data", {
+  md_default_snapshot = "management_example_values.dat"
+  announce_snapshot_file(md_default_snapshot)
+
+  extdata = system.file("extdata", package = "growR")
+  example_management_file = file.path(extdata, "posieux_management1.txt")
+  M = ManagementData$new(example_management_file)
+
+  path = save_temp_output(M)
+  expect_snapshot_file(path, md_default_snapshot, compare = compare_file_text)
+})
+
+test_that("ManagementData input checking", {
+  # Store old options for resetting after test
+  old_opts = options()
+  on.exit(options(old_opts))
+  set_growR_verbosity(5)
+
+  incomplete_management_data = data.frame(year = 1)
+  M = ManagementData$new()
+  M$management_file = "<testthat>"
+  expect_error(M$ensure_file_integrity(incomplete_management_data),
+               regexp = "parameters were missing")
+
+  wrong_DOY_management_data = data.frame(year = c(1, 1, 1), DOY = c(1, 3, 2))
+  expect_error(M$ensure_file_integrity(wrong_DOY_management_data),
+               regexp = "not monotonically increasing")
+
+  wrong_DOY_management_data2 = data.frame(year = c(1, 1, 1), DOY = c(1, 2, 2))
+  expect_error(M$ensure_file_integrity(wrong_DOY_management_data2),
+               regexp = "not monotonically increasing")
+
+  fake_management_data = data.frame(year = c(1, 1, 1), DOY = c(1, 2, 3))
+  expect_no_error(M$ensure_file_integrity(fake_management_data))
+
 })