Added a test on model wrapper results format

SticsRPacks · Feb 17, 2020 · fdbcd40 · fdbcd40
1 parent 326159f
commit fdbcd40
Show file tree

Hide file tree

Showing 106 changed files with 713 additions and 75 deletions.
diff --git a/R/is_data.R b/R/is_data.R
@@ -0,0 +1,129 @@
+#' @title Check format of data storage (for simulation results or observations)
+#'
+#' @param data_list List of values to check
+#'
+#' @return TRUE if data_list has the expected format, FALSE otherwise (+ warnings)
+#'
+#' @details data is expected to be stored in a vector of named list containing for
+#' each situation a data.frame with a column "Date" plus one column per variable
+#'
+#' @examples
+#'
+#' data_list <- list(sit1=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-10")),var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-5")),var1=c(1.3,2)))
+#' CroptimizR:::is.data(data_list)
+#'
+#' # Missing Date column
+#' data_list <- list(sit1=data.frame(var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-5")),var1=c(1.3,2)))
+#' CroptimizR:::is.data(data_list)
+#'
+#' # Bad Date format
+#' data_list <- list(sit1=data.frame(Date=c("2009-11-30","2009-12-10"),var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=c("2009-11-30","2009-12-5"),var1=c(1.3,2)))
+#' CroptimizR:::is.data(data_list)
+#'
+#' @keywords internal
+#'
+is.data <- function(data_list) {
+
+  # Check data_list format
+  if (!is.list(data_list) || !all(sapply(data_list, function(x) is.data.frame(x))) ) {
+    warning("Incorrect format: Should be a named list containing data.frames.")
+    return(FALSE)
+  }
+  # Check existence of Date column
+  if (!all(sapply(data_list, function(x) is.element("Date",colnames(x))))) {
+    warning("Incorrect format: all data.frames in the list must contain a column named Date.")
+    return(FALSE)
+  }
+  # Check format of Date column
+  if (!all(sapply(data_list, function(x) all(lubridate::is.POSIXct(x$Date)))) &&
+      !all(sapply(data_list, function(x) all(lubridate::is.Date(x$Date)))) ) {
+    warning("Incorrect format: Date column in data.frame must contain values in Date or POSIXct format.")
+    return(FALSE)
+  }
+
+  return(TRUE)
+
+}
+
+
+#' @title Check format of simulated data list
+#'
+#' @param sim_list List of simulation results to check
+#'
+#' @return TRUE if sim_list has the good format, FALSE otherwise (+ warnings)
+#'
+#' @examples
+#'
+#' sim_list <- vector("list",2)
+#' sim_list[[1]] <- list(sit1=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-10")),var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-5")),var1=c(1.3,2)))
+#' sim_list[[2]] <- list(sit1=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-10")),var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-5")),var1=c(1.3,2)))
+#' CroptimizR:::is.sim(sim_list)
+#'
+#' # Missing Date column
+#' sim_list <- vector("list",2)
+#' sim_list[[1]] <- list(sit1=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-10")),var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-5")),var1=c(1.3,2)))
+#' sim_list[[2]] <- list(sit1=data.frame(var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-5")),var1=c(1.3,2)))
+#' CroptimizR:::is.sim(sim_list)
+#'
+#' # Bad Date format
+#' sim_list <- vector("list",1)
+#' sim_list[[1]] <- list(sit1=data.frame(Date=c("2009-11-30","2009-12-10"),var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=c("2009-11-30","2009-12-5"),var1=c(1.3,2)))
+#' CroptimizR:::is.sim(sim_list)
+#'
+#' @keywords internal
+#'
+is.sim <- function(sim_list) {
+
+  if (!all(sapply(sim_list, CroptimizR:::is.data))) {
+    warning("Variable storing simulated data has an incorrect format.")
+    return(FALSE)
+  }
+
+  return(TRUE)
+
+}
+
+
+#' @title Check format of observation list
+#'
+#' @param obs_list List of observed values to check
+#'
+#' @return TRUE if obs_list has the good format, FALSE otherwise (+ warnings)
+#'
+#' @examples
+#'
+#' obs_list <- list(sit1=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-10")),var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-5")),var1=c(1.3,2)))
+#' CroptimizR:::is.obs(obs_list)
+#'
+#' # Missing Date column
+#' obs_list <- list(sit1=data.frame(var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=as.POSIXct(c("2009-11-30","2009-12-5")),var1=c(1.3,2)))
+#' CroptimizR:::is.obs(obs_list)
+#'
+#' # Bad Date format
+#' obs_list <- list(sit1=data.frame(Date=c("2009-11-30","2009-12-10"),var1=c(1.1,1.5),var2=c(NA,2.1)),
+#'                  sit2=data.frame(Date=c("2009-11-30","2009-12-5"),var1=c(1.3,2)))
+#' CroptimizR:::is.obs(obs_list)
+#'
+#' @keywords internal
+#'
+is.obs <- function(obs_list) {
+
+  if (!CroptimizR:::is.data(obs_list)) {
+    warning("Variable storing observed data has an incorrect format.")
+    return(FALSE)
+  }
+
+return(TRUE)
+
+}
+
diff --git a/R/is_obs.R b/R/is_obs.R
diff --git a/R/main_crit.R b/R/main_crit.R
@@ -53,12 +53,16 @@ main_crit <- function(param_values, crit_options) {
                                   param_values = param_values_array,
                                   sit_var_dates_mask = obs_list)
 
-  if (model_results$error) {
+  # Check results
+  if (!is.null(model_results$error) && model_results$error) {
     warning("Error in model simulations")
   }
   if (is.null(model_results$sim_list[[1]]) || length(model_results$sim_list[[1]])==0) {
     stop("Error: model wrapper returned an empty list!")
   }
+  if (!is.sim(model_results$sim_list)) {
+    stop("Error: format of results returned by the model wrapper is incorrect!")
+  }
 
   # intersect sim and obs
   obs_sim_list <- intersect_sim_obs(model_results$sim_list[[1]], obs_list)

diff --git a/docs/articles/Designing_a_model_wrapper.html b/docs/articles/Designing_a_model_wrapper.html
diff --git a/docs/reference/Rplots.pdf b/docs/reference/Rplots.pdf
diff --git a/docs/reference/Rplots1.pdf b/docs/reference/Rplots1.pdf
diff --git a/docs/reference/Rplots10.pdf b/docs/reference/Rplots10.pdf
diff --git a/docs/reference/Rplots11.pdf b/docs/reference/Rplots11.pdf
diff --git a/docs/reference/Rplots12.pdf b/docs/reference/Rplots12.pdf
diff --git a/docs/reference/Rplots13.pdf b/docs/reference/Rplots13.pdf
diff --git a/docs/reference/Rplots14.pdf b/docs/reference/Rplots14.pdf
diff --git a/docs/reference/Rplots15.pdf b/docs/reference/Rplots15.pdf
diff --git a/docs/reference/Rplots16.pdf b/docs/reference/Rplots16.pdf
diff --git a/docs/reference/Rplots17.pdf b/docs/reference/Rplots17.pdf
diff --git a/docs/reference/Rplots18.pdf b/docs/reference/Rplots18.pdf
diff --git a/docs/reference/Rplots19.pdf b/docs/reference/Rplots19.pdf
diff --git a/docs/reference/Rplots2.pdf b/docs/reference/Rplots2.pdf
diff --git a/docs/reference/Rplots20.pdf b/docs/reference/Rplots20.pdf
diff --git a/docs/reference/Rplots21.pdf b/docs/reference/Rplots21.pdf
diff --git a/docs/reference/Rplots22.pdf b/docs/reference/Rplots22.pdf
diff --git a/docs/reference/Rplots23.pdf b/docs/reference/Rplots23.pdf
diff --git a/docs/reference/Rplots24.pdf b/docs/reference/Rplots24.pdf
diff --git a/docs/reference/Rplots25.pdf b/docs/reference/Rplots25.pdf
diff --git a/docs/reference/Rplots26.pdf b/docs/reference/Rplots26.pdf
diff --git a/docs/reference/Rplots27.pdf b/docs/reference/Rplots27.pdf
diff --git a/docs/reference/Rplots28.pdf b/docs/reference/Rplots28.pdf
diff --git a/docs/reference/Rplots29.pdf b/docs/reference/Rplots29.pdf
diff --git a/docs/reference/Rplots3.pdf b/docs/reference/Rplots3.pdf
diff --git a/docs/reference/Rplots30.pdf b/docs/reference/Rplots30.pdf
diff --git a/docs/reference/Rplots31.pdf b/docs/reference/Rplots31.pdf
diff --git a/docs/reference/Rplots32.pdf b/docs/reference/Rplots32.pdf
diff --git a/docs/reference/Rplots33.pdf b/docs/reference/Rplots33.pdf
diff --git a/docs/reference/Rplots34.pdf b/docs/reference/Rplots34.pdf
diff --git a/docs/reference/Rplots35.pdf b/docs/reference/Rplots35.pdf
diff --git a/docs/reference/Rplots36.pdf b/docs/reference/Rplots36.pdf
diff --git a/docs/reference/Rplots37.pdf b/docs/reference/Rplots37.pdf
diff --git a/docs/reference/Rplots38.pdf b/docs/reference/Rplots38.pdf
diff --git a/docs/reference/Rplots39.pdf b/docs/reference/Rplots39.pdf
diff --git a/docs/reference/Rplots4.pdf b/docs/reference/Rplots4.pdf
diff --git a/docs/reference/Rplots40.pdf b/docs/reference/Rplots40.pdf
diff --git a/docs/reference/Rplots41.pdf b/docs/reference/Rplots41.pdf
diff --git a/docs/reference/Rplots42.pdf b/docs/reference/Rplots42.pdf
diff --git a/docs/reference/Rplots43.pdf b/docs/reference/Rplots43.pdf
diff --git a/docs/reference/Rplots44.pdf b/docs/reference/Rplots44.pdf
diff --git a/docs/reference/Rplots45.pdf b/docs/reference/Rplots45.pdf
diff --git a/docs/reference/Rplots46.pdf b/docs/reference/Rplots46.pdf
diff --git a/docs/reference/Rplots47.pdf b/docs/reference/Rplots47.pdf
diff --git a/docs/reference/Rplots48.pdf b/docs/reference/Rplots48.pdf
diff --git a/docs/reference/Rplots49.pdf b/docs/reference/Rplots49.pdf
diff --git a/docs/reference/Rplots5.pdf b/docs/reference/Rplots5.pdf
diff --git a/docs/reference/Rplots50.pdf b/docs/reference/Rplots50.pdf
diff --git a/docs/reference/Rplots51.pdf b/docs/reference/Rplots51.pdf
diff --git a/docs/reference/Rplots52.pdf b/docs/reference/Rplots52.pdf
diff --git a/docs/reference/Rplots53.pdf b/docs/reference/Rplots53.pdf
diff --git a/docs/reference/Rplots54.pdf b/docs/reference/Rplots54.pdf
diff --git a/docs/reference/Rplots55.pdf b/docs/reference/Rplots55.pdf
diff --git a/docs/reference/Rplots56.pdf b/docs/reference/Rplots56.pdf
diff --git a/docs/reference/Rplots57.pdf b/docs/reference/Rplots57.pdf
diff --git a/docs/reference/Rplots58.pdf b/docs/reference/Rplots58.pdf
diff --git a/docs/reference/Rplots59.pdf b/docs/reference/Rplots59.pdf
diff --git a/docs/reference/Rplots6.pdf b/docs/reference/Rplots6.pdf
diff --git a/docs/reference/Rplots60.pdf b/docs/reference/Rplots60.pdf
diff --git a/docs/reference/Rplots61.pdf b/docs/reference/Rplots61.pdf
diff --git a/docs/reference/Rplots62.pdf b/docs/reference/Rplots62.pdf
diff --git a/docs/reference/Rplots63.pdf b/docs/reference/Rplots63.pdf
diff --git a/docs/reference/Rplots64.pdf b/docs/reference/Rplots64.pdf
diff --git a/docs/reference/Rplots65.pdf b/docs/reference/Rplots65.pdf
diff --git a/docs/reference/Rplots66.pdf b/docs/reference/Rplots66.pdf
diff --git a/docs/reference/Rplots67.pdf b/docs/reference/Rplots67.pdf
diff --git a/docs/reference/Rplots68.pdf b/docs/reference/Rplots68.pdf
diff --git a/docs/reference/Rplots69.pdf b/docs/reference/Rplots69.pdf
diff --git a/docs/reference/Rplots7.pdf b/docs/reference/Rplots7.pdf
diff --git a/docs/reference/Rplots70.pdf b/docs/reference/Rplots70.pdf
diff --git a/docs/reference/Rplots71.pdf b/docs/reference/Rplots71.pdf
diff --git a/docs/reference/Rplots72.pdf b/docs/reference/Rplots72.pdf
diff --git a/docs/reference/Rplots73.pdf b/docs/reference/Rplots73.pdf
diff --git a/docs/reference/Rplots74.pdf b/docs/reference/Rplots74.pdf
diff --git a/docs/reference/Rplots75.pdf b/docs/reference/Rplots75.pdf
diff --git a/docs/reference/Rplots76.pdf b/docs/reference/Rplots76.pdf
diff --git a/docs/reference/Rplots77.pdf b/docs/reference/Rplots77.pdf
diff --git a/docs/reference/Rplots78.pdf b/docs/reference/Rplots78.pdf
diff --git a/docs/reference/Rplots79.pdf b/docs/reference/Rplots79.pdf
diff --git a/docs/reference/Rplots8.pdf b/docs/reference/Rplots8.pdf
diff --git a/docs/reference/Rplots80.pdf b/docs/reference/Rplots80.pdf
diff --git a/docs/reference/Rplots81.pdf b/docs/reference/Rplots81.pdf
diff --git a/docs/reference/Rplots82.pdf b/docs/reference/Rplots82.pdf
diff --git a/docs/reference/Rplots83.pdf b/docs/reference/Rplots83.pdf
diff --git a/docs/reference/Rplots84.pdf b/docs/reference/Rplots84.pdf
diff --git a/docs/reference/Rplots85.pdf b/docs/reference/Rplots85.pdf
diff --git a/docs/reference/Rplots86.pdf b/docs/reference/Rplots86.pdf
diff --git a/docs/reference/Rplots87.pdf b/docs/reference/Rplots87.pdf
diff --git a/docs/reference/Rplots88.pdf b/docs/reference/Rplots88.pdf
diff --git a/docs/reference/Rplots89.pdf b/docs/reference/Rplots89.pdf
diff --git a/docs/reference/Rplots9.pdf b/docs/reference/Rplots9.pdf
diff --git a/docs/reference/Rplots90.pdf b/docs/reference/Rplots90.pdf
diff --git a/docs/reference/Rplots91.pdf b/docs/reference/Rplots91.pdf
diff --git a/docs/reference/index.html b/docs/reference/index.html