From 4fd009ffc339e0b5381bb87924b3fe84a17c356f Mon Sep 17 00:00:00 2001 From: Kevin Kramer Date: Wed, 1 Nov 2023 09:43:09 +0100 Subject: [PATCH] Weather and ManagementData input checking + tests --- .github/workflows/R-CMD-check.yaml | 4 +- DESCRIPTION | 2 +- NEWS.md | 5 ++ R/management.R | 27 +++++++++ R/parameter_scan.R | 5 +- R/parameters.R | 18 +++--- R/utilities.R | 22 +++++++ R/weather.R | 21 ++++++- man/ManagementData.Rd | 19 ++++++ man/ModvegeParameters.Rd | 1 - man/WeatherData.Rd | 20 +++++++ man/ensure_table_columns.Rd | 20 +++++++ .../management/weather_example_values.dat | 1 + .../weather/management_example_values.dat | 1 + tests/testthat/test-management.R | 42 +++++++++++++ tests/testthat/test-weather.R | 59 ++++++++++++++----- 16 files changed, 234 insertions(+), 33 deletions(-) create mode 100644 man/ensure_table_columns.Rd create mode 100644 tests/testthat/_snaps/management/weather_example_values.dat create mode 100644 tests/testthat/_snaps/weather/management_example_values.dat create mode 100644 tests/testthat/test-management.R diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index a3ac618..57d153e 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.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 diff --git a/DESCRIPTION b/DESCRIPTION index c43f83e..3b39212 100644 --- a/DESCRIPTION +++ b/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", diff --git a/NEWS.md b/NEWS.md index 64b3fc2..a0343d8 100644 --- a/NEWS.md +++ b/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 diff --git a/R/management.R b/R/management.R index 5882745..2d81df0 100644 --- a/R/management.R +++ b/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 diff --git a/R/parameter_scan.R b/R/parameter_scan.R index 71a10f6..96db678 100644 --- a/R/parameter_scan.R +++ b/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) } diff --git a/R/parameters.R b/R/parameters.R index 3989768..bc13d31 100644 --- a/R/parameters.R +++ b/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) } ) diff --git a/R/utilities.R b/R/utilities.R index 5c44a93..a982f77 100644 --- a/R/utilities.R +++ b/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) + } +} + diff --git a/R/weather.R b/R/weather.R index 8536f3e..be9683e 100644 --- a/R/weather.R +++ b/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. #' diff --git a/man/ManagementData.Rd b/man/ManagementData.Rd index 83284a0..bd37198 100644 --- a/man/ManagementData.Rd +++ b/man/ManagementData.Rd @@ -43,6 +43,7 @@ c("high", "middle", "low").} \itemize{ \item \href{#method-ManagementData-new}{\code{ManagementData$new()}} \item \href{#method-ManagementData-read_management}{\code{ManagementData$read_management()}} +\item \href{#method-ManagementData-ensure_file_integrity}{\code{ManagementData$ensure_file_integrity()}} \item \href{#method-ManagementData-get_management_for_year}{\code{ManagementData$get_management_for_year()}} \item \href{#method-ManagementData-clone}{\code{ManagementData$clone()}} } @@ -92,6 +93,24 @@ None The object's field are filled. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ManagementData-ensure_file_integrity}{}}} +\subsection{Method \code{ensure_file_integrity()}}{ +Check that all required columns are present and that cut +DOYs are only increasing in a given year. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ManagementData$ensure_file_integrity(cut_data)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{cut_data}}{data.frame containing the cut data.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ManagementData-get_management_for_year}{}}} \subsection{Method \code{get_management_for_year()}}{ diff --git a/man/ModvegeParameters.Rd b/man/ModvegeParameters.Rd index f8d8078..60abd3a 100644 --- a/man/ModvegeParameters.Rd +++ b/man/ModvegeParameters.Rd @@ -210,7 +210,6 @@ order to reflect the changes in the parameter list \code{self$P}. \if{latex}{\out{\hypertarget{method-ModvegeParameters-check_parameters}{}}} \subsection{Method \code{check_parameters()}}{ Parameter Sanity Check - Ensure that the supplied \emph{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 diff --git a/man/WeatherData.Rd b/man/WeatherData.Rd index 0eb4483..175bc96 100644 --- a/man/WeatherData.Rd +++ b/man/WeatherData.Rd @@ -70,6 +70,7 @@ weather data only for a given year. The keys in the list are: \itemize{ \item \href{#method-WeatherData-new}{\code{WeatherData$new()}} \item \href{#method-WeatherData-read_weather}{\code{WeatherData$read_weather()}} +\item \href{#method-WeatherData-ensure_file_integrity}{\code{WeatherData$ensure_file_integrity()}} \item \href{#method-WeatherData-calculate_day_length}{\code{WeatherData$calculate_day_length()}} \item \href{#method-WeatherData-get_weather_for_year}{\code{WeatherData$get_weather_for_year()}} \item \href{#method-WeatherData-clone}{\code{WeatherData$clone()}} @@ -117,6 +118,25 @@ Default (NULL) is to read in all found years.} } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-WeatherData-ensure_file_integrity}{}}} +\subsection{Method \code{ensure_file_integrity()}}{ +Check if supplied input file is formatted correctly. + +Check if required column names are present and fix NA entries. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{WeatherData$ensure_file_integrity(weather)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{weather}}{data.table of the read input file with \code{header = TRUE}.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-WeatherData-calculate_day_length}{}}} \subsection{Method \code{calculate_day_length()}}{ diff --git a/man/ensure_table_columns.Rd b/man/ensure_table_columns.Rd new file mode 100644 index 0000000..622bf08 --- /dev/null +++ b/man/ensure_table_columns.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{ensure_table_columns} +\alias{ensure_table_columns} +\title{Check if supplied table contains all *required* variables.} +\usage{ +ensure_table_columns(required, data, data_name = "the data table") +} +\arguments{ +\item{required}{List of names of required variables.} + +\item{data}{data.frame or similar object to be checked.} + +\item{data_name}{Name to be displayed in the error message if any variable +is missing.} +} +\description{ +Logs an error if any variable is missing and lists the missing variables +in the error message along with *data_name*. +} diff --git a/tests/testthat/_snaps/management/weather_example_values.dat b/tests/testthat/_snaps/management/weather_example_values.dat new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/tests/testthat/_snaps/management/weather_example_values.dat @@ -0,0 +1 @@ + diff --git a/tests/testthat/_snaps/weather/management_example_values.dat b/tests/testthat/_snaps/weather/management_example_values.dat new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/tests/testthat/_snaps/weather/management_example_values.dat @@ -0,0 +1 @@ + diff --git a/tests/testthat/test-management.R b/tests/testthat/test-management.R new file mode 100644 index 0000000..83e27f0 --- /dev/null +++ b/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 = "" + + 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))) + +}) diff --git a/tests/testthat/test-weather.R b/tests/testthat/test-weather.R index b1089ea..1b65c72 100644 --- a/tests/testthat/test-weather.R +++ b/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 = "" + 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)) + })