Test reproducing the FOCUS Summary information

generated from the FOCUS PELMO GUI, as copied into the text files
in the testdata directory.

1 files changed, 56 insertions, 26 deletions

diff --git a/R/PELMO_runs.R b/R/PELMO_runs.R
index f708fa0..3d4f03b 100644
--- a/R/PELMO_runs.R
+++ b/R/PELMO_runs.R
@@ -8,6 +8,12 @@
 #' installed into the package installation directory of \code{PELMO.installeR}
 #' and run using \code{wine}.
 #'
+#' As a side effect, an R data file (period_pfm.rda) is generated in each
+#' run directory, holding the results for all FOCUS periods, equivalent to
+#' the period.plm file generated by the FOCUS PELMO GUI.
+#'
+#' @return If evaluate is TRUE, a list of lists of data frames holding the
+#'   PEC data.
 #' @param runs A list of lists. Each inner lists has an element named 'psm'
 #'   that holds the psm string, and elements named using three letter crop acronyms,
 #'   as used in \code{\link{FOCUS_PELMO_crops}},
@@ -21,7 +27,7 @@
 #' @param evaluate Should the results be returned?
 #' @param overwrite Should an existing run directories be overwritten
 #' @references PELMO.installeR \url{https://jranke.github.io/PELMO.installeR}
-#' 
+#'
 #' Wine \url{https://winehq.org}
 #' @export
 PELMO_runs <- function(runs, psm_dir = ".", version = "5.5.3", PELMO_base = "auto",
@@ -146,7 +152,10 @@ PELMO_runs <- function(runs, psm_dir = ".", version = "5.5.3", PELMO_base = "aut
   }
 
   if (evaluate) {
-    evaluate_PELMO(runs, version = version, PELMO_base = PELMO_base)
+    pfm_PECgw <- evaluate_PELMO(runs, version = version, PELMO_base = PELMO_base)
+    return(pfm_PECgw)
+  } else {
+    invisible(NULL)
   }
 }
 
@@ -223,7 +232,7 @@ run_PELMO <- function(runs, version = "5.5.3", PELMO_base = "auto",
 #' @param psm The psm identifier
 #' @param crop The PELMO crop acronym
 #' @param scenario The scenario
-PELMO_path <- function(psm, crop, scenario) {
+PELMO_path <- function(psm, crop, scenario = NA) {
   if (crop %in% names(FOCUS_PELMO_crops)) {
     crop <- FOCUS_PELMO_crops[crop]
   }
@@ -237,24 +246,28 @@ PELMO_path <- function(psm, crop, scenario) {
   # scenario
   irrigation_string <- ""
 
-  # 'Irrigation' is only possible in the GUI for five scenarios
-  if (scenario %in% c("Cha", "Pia", "Por", "Sev", "Thi")) {
-    crop_acronyms <- names(FOCUS_PELMO_crops)
-    names(crop_acronyms) <- FOCUS_PELMO_crops
-    crop_acronym <- crop_acronyms[[crop]]
-    # Some crops are not 'irrigated' according to the GUI
-    if (crop_acronym %in% c("win", "fbe", "woi", "ape", "spr")) {
-      irrigation_string <- "--_-_no_-_irrigation"
-    } else {
-      irrigation_string <- "--_-_irrigated"
+  if (is.na(scenario)) {
+    return(file.path(psm_dir, crop_dir))
+  } else {
+    # 'Irrigation' is only possible in the GUI for five scenarios
+    if (scenario %in% c("Cha", "Pia", "Por", "Sev", "Thi")) {
+      crop_acronyms <- names(FOCUS_PELMO_crops)
+      names(crop_acronyms) <- FOCUS_PELMO_crops
+      crop_acronym <- crop_acronyms[[crop]]
+      # Some crops are not 'irrigated' according to the GUI
+      if (crop_acronym %in% c("win", "fbe", "woi", "ape", "spr")) {
+        irrigation_string <- "--_-_no_-_irrigation"
+      } else {
+        irrigation_string <- "--_-_irrigated"
+      }
     }
-  }
 
-  scenario_dir <- paste0(
-    FOCUS_GW_scenarios_2012$names[scenario], "_-_(", FOCUS_PELMO_location_codes[scenario], ")",
-    irrigation_string, ".run")
+    scenario_dir <- paste0(
+      FOCUS_GW_scenarios_2012$names[scenario], "_-_(", FOCUS_PELMO_location_codes[scenario], ")",
+      irrigation_string, ".run")
 
-  return(file.path(psm_dir, crop_dir, scenario_dir))
+    return(file.path(psm_dir, crop_dir, scenario_dir))
+  }
 }
 
 #' Create a list of runs that we can traverse
@@ -304,18 +317,30 @@ evaluate_PELMO <- function(runs, version = "5.5.3", PELMO_base = "auto")
                                        paste0("FOCUSPELMO.", gsub("\\.", "", version)))
   }
 
+  pfm_PECgw <- list()
   for (run in runs) {
     psm <- run$psm
+    pfm_PECgw[[psm]] <- list()
     crops <- setdiff(names(run), "psm")
+
+    # Get acronyms of simulated compounds
+    example_run_dir <- file.path(PELMO_base, "FOCUS", PELMO_path(psm, crops[1], run[[crops[1]]][1]))
+    example_echo_file <- readLines(file.path(example_run_dir, "ECHO.PLM"), encoding = "latin1")
+    parm_lines <- grep("\\*\\*\\* PARAMETERS OF", example_echo_file, value = TRUE)
+    acronyms <- gsub(".*\\((.*)\\).*", "\\1", parm_lines)
+    met_codes <- gsub(".*METABOLITE (..).*", "\\1", parm_lines)
+    met_codes[1] <- NA
+    names(met_codes) <- acronyms
+
+    # Loop over runs to get results
     for (crop in crops) {
-      for (scenario in run[[crop]]) {
+      scenarios <- run[[crop]]
+
+      pfm_PECgw[[psm]][[crop]] <- matrix(nrow = length(scenarios), ncol = length(acronyms),
+                                         dimnames = list(scenarios, acronyms))
+
+      for (scenario in scenarios) {
         run_dir <- file.path(PELMO_base, "FOCUS", PELMO_path(psm, crop, scenario))
-        echo_file <- readLines(file.path(run_dir, "ECHO.PLM"), encoding = "latin1")
-        parm_lines <- grep("\\*\\*\\* PARAMETERS OF", echo_file, value = TRUE)
-        acronyms <- gsub(".*\\((.*)\\).*", "\\1", parm_lines)
-        met_codes <- gsub(".*METABOLITE (..).*", "\\1", parm_lines)
-        met_codes[1] <- NA
-        names(met_codes) <- acronyms
 
         psm_file <- file.path(run_dir, paste0(psm, ".psm"))
         location_code <- FOCUS_PELMO_location_codes[scenario]
@@ -349,12 +374,17 @@ evaluate_PELMO <- function(runs, version = "5.5.3", PELMO_base = "auto")
           periods$conc <- 100 * periods$flux / periods$percolate
 
           results_pfm[[acronym]]$periods <- periods
-          results_pfm[[acronym]]$focus <- focus_80th(periods$conc)
+          PECgw <- focus_80th(periods$conc)
+
+          results_pfm[[acronym]]$focus <- PECgw
+
+          pfm_PECgw[[psm]][[crop]][scenario, acronym] <- round(PECgw, 3)
         }
         save(results_pfm, file = file.path(run_dir, "period_pfm.rda"))
       }
     }
   }
+  return(pfm_PECgw)
 }
 
 #' Get the application interval in years from a psm file